Code
knitr::opts_chunk$set(cache = TRUE)Hooded Plover Nest Survival
Exploration of dataset thus far
Prerequisites
R packages
- The following packages are needed for analysis and can be easily installed from CRAN or GitHub by running the following code chunk:
Code
# a vector of all the packages needed in the project
packages_required_in_project <- c("tidyverse",
"readxl",
"RMark",
"RColorBrewer",
"patchwork",
"mapview",
"lubridate",
"extrafont",
"here",
"DT",
"leaflet",
"sf",
"leafpop",
"tsibble",
"corrplot",
"gghalves",
"gam",
"pscl",
"gamlss")
# of the required packages, check if some need to be installed
new.packages <-
packages_required_in_project[!(packages_required_in_project %in%
installed.packages()[,"Package"])]
# install all packages that are not locally available
if(length(new.packages)) install.packages(new.packages)
# load all the packages into the current R session
lapply(packages_required_in_project, require, character.only = TRUE)
# set the home directory to where the project is locally based (i.e., to find
# the relevant datasets to import, etc.
here::set_here()Plotting themes
- The following plotting themes, colors, and typefaces are used throughout the project:
Code
# Find fonts from computer that you want. Use regular expressions to do this
# For example, load all fonts that are 'verdana' or 'Verdana'
extrafont::font_import(pattern = "[V/v]erdana", prompt = FALSE)
# check which fonts were loaded
extrafont::fonts()
extrafont::fonttable()
extrafont::loadfonts() # load these into R
# define the plotting theme to be used in subsequent ggplots
luke_theme <-
theme_bw() +
theme(
text = element_text(family = "Verdana"),
legend.title = element_text(size = 10),
legend.text = element_text(size = 8),
axis.title.x = element_text(size = 10),
axis.text.x = element_text(size = 8),
axis.title.y = element_text(size = 10),
axis.text.y = element_text(size = 8),
strip.text = element_text(size = 10),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.ticks = element_line(size = 0.5, colour = "grey40"),
axis.ticks.length = unit(0.2, "cm"),
panel.border = element_rect(linetype = "solid", colour = "grey"),
legend.position = c(0.1, 0.9)
)
# set mapview to show satellite imagery
# mapviewOptions(basemaps = c("Esri.WorldImagery"))
# # set plotting color palettes
# sex_pal2 <-
# c(pull(ggthemes_data$wsj$palettes$colors6[3,2]),
# pull(ggthemes_data$wsj$palettes$colors6[2,2]))
#
# sex_pal3 <-
# c(pull(ggthemes_data$wsj$palettes$colors6[3,2]),
# pull(ggthemes_data$wsj$palettes$colors6[3,2]),
# pull(ggthemes_data$wsj$palettes$colors6[2,2]),
# pull(ggthemes_data$wsj$palettes$colors6[2,2]))
#
# # specify the facet labels for each species and sex
# species_names <- c(
# 'BC' = "Black coucal",
# 'WBC' = "White-browed coucal")
#
# sex_names <- c(
# 'female' = "Females",
# 'male' = "Males")
#
# analysis_names <- c(
# 'male' = "Male Mo scenario",
# 'female' = "Female Mo scenario"
# )
#
# # color of mean estimate point in forest plots
# col_all <- "#2E3440"
#
# # custom color palette for the plotting of Juvenile and Adult stats
# cbPalette_LTRE <-
# c("#D9D9D9", "#D9D9D9", "#D9D9D9",
# "#D9D9D9", "#A6A6A6", "#A6A6A6",
# "#A6A6A6")
#
# cbPalette_sex_diff <-
# c("#D9D9D9", "#D9D9D9", "#D9D9D9",
# "#D9D9D9", "#A6A6A6")
#
# # plot the comparative LTRE results
# vital_rate_theme <-
# theme_bw() +
# theme(
# text = element_text(family = "Verdana"),
# legend.position = "none",
# panel.grid.major = element_blank(),
# panel.grid.minor = element_blank(),
# axis.ticks.length = unit(0.1, "cm"),
# panel.border = element_blank(),
# panel.spacing.x = unit(0.3, "lines"),
# panel.spacing.y = unit(0.7, "lines"),
# strip.background = element_blank()
# )
# species.labs <- c("Black Coucal", "White-browed Coucal")
# names(species.labs) <- c("BC", "WBC")Project-specific Functions
The following custom functions are used to
%!in%
This function simply does the opposite of %in%, which is used to test if elements on the left-hand side are members of the set defined by the right-hand side. %!in% returns a logical vector indicating whether each element on the left-hand side is not present in the right-hand side.
Code
`%!in%` = Negate(`%in%`)lucinda_nest_import()
This function imports the HOPL nest survival data stored as Excel sheets into R, wrangles it into a single dataframe, and prepares it for subsequent analysis (e.g., specifies relevent date columns, etc.)
arguments:
year_1: first calender year of the focal data sheet (e.g., 2002)year_2: second calender year of the focal data set (i.e., always year_1 + 1)file_name: name of the Excel sheet to import data fromsite: site that the data describes (MP, FP, or BSC)extra_text: the extra text associated with each sheet in the Excel file (i.e., besides from the year)first_found_date_col: the number of the column in the sheets that correspond to the first found datelast_alive_date_col: the number of the column in the sheets that correspond to the last alive datelast_checked_col: the number of the column in the sheets that correspond to the last checked date
Code
lucinda_nest_import <-
function(year_1, year_2, file_name, site, extra_text = NULL,
first_found_date_col, last_alive_date_col, last_checked_col) {
if(is.null(extra_text)){
file <-
read_excel(paste0("data/final/final_final/", file_name),
sheet = paste0(site, " ", year_1, "_", str_sub(year_2, 3, 4)),
col_types = "text", na = "n/a")
}
else{
file <-
read_excel(paste0("data/final/final_final/", file_name),
sheet = paste0(site, " ", year_1, "_", str_sub(year_2, 3, 4), extra_text),
col_types = "text", na = "n/a")
}
file %>%
# simplify column names
rename(first_found = first_found_date_col,
last_alive = last_alive_date_col,
last_checked = last_checked_col,
Fate = `Hatch?`,
season = Season,
site = Site,
nest_ID = `Nest ID`,
nest_hab = `Nest habitat`,
management_status = `Nest managed?`,
management_type = `Management type`,
nest_lat = `Nest latitude`,
nest_lon = `Nest longitude`) %>%
# consolidate columns
dplyr::select(season, site, nest_ID, first_found, last_alive, last_checked, Fate, nest_hab,
management_status, management_type, nest_lat, nest_lon, site) %>%
# wrangle: if date last alive is "Unk." make it "NA"
mutate(last_alive = ifelse(str_detect(last_alive, "Unk."), NA, last_alive),
# change Fate to 1 or 0 (1 = failed, 0 = hatched)
Fate = ifelse(Fate == "Y", 0, 1)) %>%
mutate(
# wrangle: if last_alive has a date and last_checked is NA, then change
# last_checked to the date in last_alive
last_checked = ifelse(!is.na(last_alive) & is.na(last_checked),
last_alive,
# if both last_alive and last_checked is "NA", then
# change last_checked to the first_found date
ifelse(is.na(last_alive) & is.na(last_checked),
first_found,
last_checked))) %>%
mutate(
# wrangle: if last_alive is NA and the nest hatched and last_checked has a
# date, then specify last_alive as the date from last_checked
last_alive = ifelse(is.na(last_alive) & Fate == "0" & !is.na(last_checked),
last_checked,
# if the last_alive is NA and the nest failed and
# last_checked has a date, then specify last_alive as the
# date from first_found
ifelse(is.na(last_alive) & Fate == "1" & !is.na(last_checked),
first_found,
last_alive))) %>%
filter(nchar(first_found) == 8 & nchar(last_alive) == 8 & nchar(last_checked) == 8) %>%
# specify date columns as a date string
mutate(first_found2 = as.Date(paste(str_sub(first_found, 5, 8),
str_sub(first_found, 3, 4),
str_sub(first_found, 1, 2), sep = "-")),
last_alive2 = as.Date(paste(str_sub(last_alive, 5, 8),
str_sub(last_alive, 3, 4),
str_sub(last_alive, 1, 2), sep = "-")),
last_checked2 = as.Date(paste(str_sub(last_checked, 5, 8),
str_sub(last_checked, 3, 4),
str_sub(last_checked, 1, 2), sep = "-"))) %>%
# if last checked date is before last alive date, then change it to the
# last alive date, if not then leave as is
# mutate(last_checked2 = ifelse(last_checked2 < last_alive2 | (is.na(last_checked2) & !is.na(last_alive2)), last_alive2, last_checked2)) %>%
# julian dates
mutate(FirstFound = as.numeric(format(first_found2 + 180, "%j")),
LastPresent = as.numeric(format(last_alive2 + 180, "%j")),
LastChecked = as.numeric(format(last_checked2 + 180, "%j"))) %>%
# remove all nests that have unknown fate
filter(!is.na(Fate)) %>%
# clean up the management_type column
mutate(management_type = tolower(management_type)) %>%
mutate(management_type = str_replace(management_type, "acess", "access")) %>%
mutate(management_type = str_replace(management_type, "and", ",")) %>%
mutate(management_type = str_replace(management_type, "temporary", "")) %>%
mutate(management_type = str_replace_all(management_type, " ", "")) %>%
mutate(management_type = str_replace_all(management_type, "shelters", "")) %>%
mutate(management_type = str_replace_all(management_type, "banners", "")) %>%
mutate(management_type = str_replace_all(management_type, ",,", ",")) %>%
mutate(sign_access = ifelse(str_detect(management_type, "signaccess"), 1, 0)) %>%
mutate(sign_nest = ifelse(str_detect(management_type, "signnest"), 1, 0)) %>%
mutate(rope_fence = ifelse(str_detect(management_type, "ropefence"), 1, 0)) %>%
mutate(wardens = ifelse(str_detect(management_type, "wardens"), 1, 0)) %>%
mutate(none = ifelse(str_detect(management_type, "none"), 1, 0)) %>%
mutate(other = ifelse(str_detect(management_type, "other"), 1, 0)) %>%
mutate(management_level = ifelse(sign_access == 1 & sign_nest == 1 & rope_fence == 1 & wardens == 1, 4,
ifelse(rope_fence == 1, 3,
ifelse(sign_nest == 1, 2,
ifelse(sign_access == 1, 1,
ifelse(none == 1, 0, NA)))))) %>%
mutate(sign_nest_no_sign_access = ifelse(sign_access == 0 & sign_nest == 1, 1, 0)) %>%
mutate(fence_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & rope_fence == 1, 1, 0)) %>%
mutate(wardens_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & wardens == 1, 1, 0)) %>%
mutate(wardens_no_fence = ifelse(rope_fence == 1 & wardens == 1, 1, 0)) %>%
mutate(just_wardens = ifelse(rope_fence == 0 & sign_access == 0 & sign_nest == 0 & wardens == 1, 1, 0)) %>%
dplyr::select(#-management_type, -sign_access, -sign_nest, -rope_fence,
#-wardens, -none,
-other,
-sign_nest_no_sign_access, -fence_no_sign,
-wardens_no_sign, -wardens_no_fence, -just_wardens) %>%
mutate(site = str_extract(nest_ID, "_([^_]+)_") %>% str_remove_all("_"))
}Importing and checking nest survival data
Mornington Peninsula
Flag potential issues in data
First we import the data and run a few checks to assess if there are any rows with the following issues:
found date is not 8 characters
last seen alive date is not 8 characters
last checked date is not 8 characters
found date missing
last seen alive date missing
last checked date missing
Nest managed? is not Y or N
Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks
Management type is not sufficient for making levels
Double check dates because incuabation time greater than 35 days
Found date is after Last Alive date (should be greater or equal)
Found date is after Last Checked date (should be greater or equal)
Last Checked date is before Last Alive date (should be greater or equal)
Code
suppressMessages(
bind_rows(
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2020", "_", str_sub("2021", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2019", "_", str_sub("2020", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2018", "_", str_sub("2019", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2017", "_", str_sub("2018", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2016", "_", str_sub("2017", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2015", "_", str_sub("2016", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2014", "_", str_sub("2015", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2013", "_", str_sub("2014", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2012", "_", str_sub("2013", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2011", "_", str_sub("2012", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2010", "_", str_sub("2011", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2009", "_", str_sub("2010", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2008", "_", str_sub("2009", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2007", "_", str_sub("2008", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx"),
sheet = paste0("MP", " ", "2006", "_", str_sub("2007", 3, 4)),
col_types = "text", na = "n/a"))) %>%
filter(!is.na(Season)) %>%
rename(first_found = 10,
last_alive = 27,
last_checked = 32,
Fate = `Hatch?`,
season = Season,
site = Site,
nest_ID = `Nest ID`,
nest_hab = `Nest habitat`,
management_status = `Nest managed?`,
management_type = `Management type`,
nest_lat = `Nest latitude`,
nest_lon = `Nest longitude`) %>%
dplyr::select(season, site, nest_ID, first_found, last_alive, last_checked, Fate, nest_hab,
management_status, management_type, nest_lat, nest_lon, site) %>%
mutate(last_alive = ifelse(str_detect(last_alive, "Unk."), NA, last_alive),
Fate = ifelse(Fate == "Y", 0, 1)) %>%
mutate(
last_checked = ifelse(!is.na(last_alive) & is.na(last_checked),
last_alive,
ifelse(is.na(last_alive) & is.na(last_checked),
first_found,
last_checked))) %>%
mutate(
last_alive = ifelse(is.na(last_alive) & Fate == "0" & !is.na(last_checked),
last_checked,
ifelse(is.na(last_alive) & Fate == "1" & !is.na(last_checked),
first_found,
last_alive))) %>%
mutate(first_found2 = as.Date(paste(str_sub(first_found, 5, 8),
str_sub(first_found, 3, 4),
str_sub(first_found, 1, 2), sep = "-")),
last_alive2 = as.Date(paste(str_sub(last_alive, 5, 8),
str_sub(last_alive, 3, 4),
str_sub(last_alive, 1, 2), sep = "-")),
last_checked2 = as.Date(paste(str_sub(last_checked, 5, 8),
str_sub(last_checked, 3, 4),
str_sub(last_checked, 1, 2), sep = "-"))) %>%
mutate(FirstFound = as.numeric(format(first_found2 + 180, "%j")),
LastPresent = as.numeric(format(last_alive2 + 180, "%j")),
LastChecked = as.numeric(format(last_checked2 + 180, "%j"))) %>%
mutate(management_type = tolower(management_type)) %>%
mutate(management_type = str_replace(management_type, "acess", "access")) %>%
mutate(management_type = str_replace(management_type, "and", ",")) %>%
mutate(management_type = str_replace(management_type, "temporary", "")) %>%
mutate(management_type = str_replace_all(management_type, " ", "")) %>%
mutate(management_type = str_replace_all(management_type, "shelters", "")) %>%
mutate(management_type = str_replace_all(management_type, "banners", "")) %>%
mutate(management_type = str_replace_all(management_type, ",,", ",")) %>%
mutate(sign_access = ifelse(str_detect(management_type, "signaccess"), 1, 0)) %>%
mutate(sign_nest = ifelse(str_detect(management_type, "signnest"), 1, 0)) %>%
mutate(rope_fence = ifelse(str_detect(management_type, "ropefence"), 1, 0)) %>%
mutate(wardens = ifelse(str_detect(management_type, "wardens"), 1, 0)) %>%
mutate(none = ifelse(str_detect(management_type, "none"), 1, 0)) %>%
mutate(other = ifelse(str_detect(management_type, "other"), 1, 0)) %>%
mutate(management_level = ifelse(sign_access == 1 & sign_nest == 1 & rope_fence == 1 & wardens == 1, 4,
ifelse(rope_fence == 1, 3,
ifelse(sign_nest == 1, 2,
ifelse(sign_access == 1, 1,
ifelse(none == 1, 0, NA)))))) %>%
mutate(sign_nest_no_sign_access = ifelse(sign_access == 0 & sign_nest == 1, 1, 0)) %>%
mutate(fence_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & rope_fence == 1, 1, 0)) %>%
mutate(wardens_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & wardens == 1, 1, 0)) %>%
mutate(wardens_no_fence = ifelse(rope_fence == 1 & wardens == 1, 1, 0)) %>%
mutate(just_wardens = ifelse(rope_fence == 0 & sign_access == 0 & sign_nest == 0 & wardens == 1, 1, 0)) %>%
dplyr::select(-other, -sign_nest_no_sign_access, -fence_no_sign,
-wardens_no_sign, -wardens_no_fence, -just_wardens) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
mutate(region = "MP") %>%
mutate(site = as.factor(site)) %>%
mutate(issue1 = ifelse(nchar(first_found) != 8, "found date is not 8 characters; ", NA)) %>%
mutate(issue2 = ifelse(nchar(last_alive) != 8, "last seen alive date is not 8 characters; ", NA)) %>%
mutate(issue3 = ifelse(nchar(last_checked) != 8, "last checked date is not 8 characters; ", NA)) %>%
mutate(issue4 = ifelse(is.na(first_found), "found date missing; ", NA)) %>%
mutate(issue5 = ifelse(is.na(last_alive), "last seen alive date missing; ", NA)) %>%
mutate(issue6 = ifelse(is.na(last_checked), "last checked date missing; ", NA)) %>%
mutate(issue7 = ifelse(management_status %!in% c("Y", "N"), "Nest managed? is not Y or N; ", NA)) %>%
mutate(issue8 = ifelse(nest_hab %!in% c("Beach", "Dune", "Foredune/face", "Estuary/spit", "Rocks"), "Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks; ", NA)) %>%
mutate(issue9 = ifelse(is.na(management_level), "Management type is not sufficient for making levels; ", NA)) %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
mutate(issue10 = ifelse(found_and_alive_diff > 35 , "Double check dates because incuabation time greater than 35 days; ", NA)) %>%
mutate(issue11 = ifelse(FirstFound > LastPresent, "Found date is after Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issue12 = ifelse(FirstFound > LastChecked, "Found date is after Last Checked date (should be greater or equal); ", NA)) %>%
mutate(issue13 = ifelse(LastChecked < LastPresent, "Last Checked date is before Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issues = ifelse(is.na(issue1) & is.na(issue2) & is.na(issue3) &
is.na(issue4) & is.na(issue5) & is.na(issue6) &
is.na(issue7) & is.na(issue8) & is.na(issue9) &
is.na(issue10) & is.na(issue11) & is.na(issue12) & is.na(issue13), NA,
paste0(issue1, issue2, issue3,
issue4, issue5, issue6,
issue7, issue8, issue9,
issue10, issue11, issue12, issue13))) %>%
mutate(issues = str_remove_all(issues, "NA")) %>%
mutate(issues = ifelse(is.na(issues), "usable", issues)) %>%
dplyr::select(-issue1, -issue2, -issue3,
-issue4, -issue5, -issue6,
-issue7, -issue8, -issue9,
-issue10, -issue11, -issue12, -issue13) %>%
filter(issues != "usable") %>%
arrange(issues) %>%
filter(first_found != "Not found" & last_alive != "Not seen" & last_checked != "Not seen" & last_checked != "Not revisited") %>%
filter(str_detect(issues, "date")) %>%
mutate(issues = str_remove_all(issues, "Management type is not sufficient for making levels; ")) %>%
mutate(issues = str_remove_all(issues, "Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks; ")) %>%
dplyr::select(season, nest_ID, first_found, first_found2, last_alive, last_alive2, last_checked, last_checked2, Fate, found_and_alive_diff, issues) %>%
datatable(class = 'cell-border stripe', rownames = FALSE, filter = 'top')Code
# write_csv(., "data/final/final_final/nest_issues_commented/MP Nesting Summary 2020_21 to 2006_07 site names match threat data_nests_w_issues_commented.csv", col_names = TRUE, append = FALSE, quote = "all")Import data
Code
nest_data_MP <-
bind_rows(
lucinda_nest_import(year_1 = "2020", year_2 = "2021",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2019", year_2 = "2020",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2018", year_2 = "2019",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2017", year_2 = "2018",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2016", year_2 = "2017",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2015", year_2 = "2016",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2014", year_2 = "2015",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2013", year_2 = "2014",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2012", year_2 = "2013",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2011", year_2 = "2012",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2010", year_2 = "2011",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2009", year_2 = "2010",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2008", year_2 = "2009",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2007", year_2 = "2008",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32),
lucinda_nest_import(year_1 = "2006", year_2 = "2007",
file_name = "MP Nesting Summary 2020_21 to 2006_07 site names match threat data.xlsx", site = "MP",
first_found_date_col = 10,
last_alive_date_col = 27,
last_checked_col = 32)) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
filter(!is.na(FirstFound) & !is.na(LastPresent) & !is.na(LastChecked)) %>%
filter(management_status %in% c("Y", "N")) %>%
filter(nest_hab %in% c("Beach", "Dune", "Foredune/face", "Estuary/spit", "Rocks")) %>%
filter(!is.na(management_level)) %>%
mutate(region = "MP") %>%
mutate(site = as.factor(site)) %>%
ungroup()Visual inspections of data
Code
nest_data_MP_check <-
nest_data_MP %>%
ungroup() %>%
mutate(first_found2_md = paste(format(first_found2 + 180, format = "%m"),
format(first_found2 + 180, format = "%d"),
sep = "-"),
last_alive2_md = paste(format(last_alive2 + 180, format = "%m"),
format(last_alive2 + 180, format = "%d"),
sep = "-"),
last_checked2_md = paste(format(last_checked2 + 180, format = "%m"),
format(last_checked2 + 180, format = "%d"),
sep = "-")) %>%
mutate(first_found2_trans = as.Date(paste("2020", first_found2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_alive2_trans = as.Date(paste("2020", last_alive2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_checked2_trans = as.Date(paste("2020", last_checked2_md, sep = "-"), format = "%Y-%m-%d") - 179) %>%
mutate(season_label = paste0("season ", str_sub(season, 1, 4), " to ", str_sub(season, 5, 6)))Spatial distribution of data
Note that this map only shows data that are in a decimal degrees format (e.g., -38.31), NOT degree minute seconds (e.g., 38 27.59). The map is interactive, so click on an outlier to see its metadata
Code
nest_data_MP %>%
mutate(nest_lon = as.numeric(nest_lon),
nest_lat = as.numeric(nest_lat)) %>%
filter(!is.na(nest_lon) & !is.na(nest_lat)) %>%
st_as_sf(coords = c("nest_lon", "nest_lat"),
crs = 4326) %>%
mapview(popup = popupTable(.,
zcol = c("season",
"site",
"nest_ID")))Year-specific Found Date Distributions
Code
ggplot(nest_data_MP_check, aes(first_found2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_MP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_MP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 12), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Found date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Alive Date Distributions
Code
ggplot(nest_data_MP_check, aes(last_alive2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_MP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_MP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 12), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last alive date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Checked Date Distributions
Code
ggplot(nest_data_MP_check, aes(last_checked2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_MP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_MP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 12), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last checked date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Incubation length distribution
Code
# assess if there are nests with unusually long incubation periods
nest_data_MP_check %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
arrange(desc(found_and_alive_diff)) %>%
filter(first_found2 < last_alive2 & first_found2 < last_checked2 & found_and_alive_diff < 100) %>%
ggplot() +
geom_histogram(aes(found_and_alive_diff)) +
luke_theme +
xlab("Time between found date and last alive date (days)") +
ylab("Frquency of nests")
Date issues
Code
# check if there are any data in which the last alive date is a) beyond the nocc, b) less than 1, or c) NA
filter(nest_data_MP, LastPresent > nocc | LastPresent < 1 | is.na(LastPresent)) # should be nothing if correct# A tibble: 0 × 26
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# check if there are any data in which the found date is a) beyond the nocc, or b) less than 1
filter(nest_data_MP, FirstFound > nocc | FirstFound < 1) # should be nothing if correct# A tibble: 1 × 26
season site nest_ID first_found last_alive last_checked Fate nest_hab
<fct> <fct> <chr> <chr> <chr> <chr> <dbl> <fct>
1 201617 Pt Nepean (… 201617… 02032017 19022017 19022017 0 Dune
# ℹ 18 more variables: management_status <fct>, management_type <chr>,
# nest_lat <chr>, nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, region <chr>Code
# check if there are any data in which the found date is a) after the last alive or b) after the last checked date
filter(nest_data_MP, FirstFound > LastPresent | FirstFound > LastChecked) # should be nothing if correct# A tibble: 2 × 26
season site nest_ID first_found last_alive last_checked Fate nest_hab
<fct> <fct> <chr> <chr> <chr> <chr> <dbl> <fct>
1 201617 Pt Nepean (… 201617… 02032017 19022017 19022017 0 Dune
2 201516 Koonya East 201516… 17012016 15022016 16012016 0 Foredun…
# ℹ 18 more variables: management_status <fct>, management_type <chr>,
# nest_lat <chr>, nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, region <chr>Fleurieu Peninsula
Flag potential issues in data
As above, first we import the data and run a few checks to assess if there are any rows with the issues listed above
Code
suppressMessages(bind_rows(
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2020", "_", str_sub("2021", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2019", "_", str_sub("2020", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2018", "_", str_sub("2019", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2017", "_", str_sub("2018", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2016", "_", str_sub("2017", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2015", "_", str_sub("2016", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2014", "_", str_sub("2015", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2013", "_", str_sub("2014", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2012", "_", str_sub("2013", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2011", "_", str_sub("2012", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2010", "_", str_sub("2011", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx"),
sheet = paste0("FP", " ", "2009", "_", str_sub("2010", 3, 4), " Nest summary"),
col_types = "text", na = "n/a"))) %>%
rename(first_found = 10,
last_alive = 29,
last_checked = 36,
Fate = `Hatch?`,
season = Season,
site = Site,
nest_ID = `Nest ID`,
nest_hab = `Nest habitat`,
management_status = `Nest managed?`,
management_type = `Management type`,
nest_lat = `Nest latitude`,
nest_lon = `Nest longitude`) %>%
dplyr::select(season, site, nest_ID, first_found, last_alive, last_checked, Fate, nest_hab,
management_status, management_type, nest_lat, nest_lon, site) %>%
mutate(last_alive = ifelse(str_detect(last_alive, "Unk."), NA, last_alive),
Fate = ifelse(Fate == "Y", 0, 1)) %>%
mutate(
last_checked = ifelse(!is.na(last_alive) & is.na(last_checked),
last_alive,
ifelse(is.na(last_alive) & is.na(last_checked),
first_found,
last_checked))) %>%
mutate(
last_alive = ifelse(is.na(last_alive) & Fate == "0" & !is.na(last_checked),
last_checked,
ifelse(is.na(last_alive) & Fate == "1" & !is.na(last_checked),
first_found,
last_alive))) %>%
mutate(first_found2 = as.Date(paste(str_sub(first_found, 5, 8),
str_sub(first_found, 3, 4),
str_sub(first_found, 1, 2), sep = "-")),
last_alive2 = as.Date(paste(str_sub(last_alive, 5, 8),
str_sub(last_alive, 3, 4),
str_sub(last_alive, 1, 2), sep = "-")),
last_checked2 = as.Date(paste(str_sub(last_checked, 5, 8),
str_sub(last_checked, 3, 4),
str_sub(last_checked, 1, 2), sep = "-"))) %>%
mutate(FirstFound = as.numeric(format(first_found2 + 180, "%j")),
LastPresent = as.numeric(format(last_alive2 + 180, "%j")),
LastChecked = as.numeric(format(last_checked2 + 180, "%j"))) %>%
mutate(management_type = tolower(management_type)) %>%
mutate(management_type = str_replace(management_type, "acess", "access")) %>%
mutate(management_type = str_replace(management_type, "and", ",")) %>%
mutate(management_type = str_replace(management_type, "temporary", "")) %>%
mutate(management_type = str_replace_all(management_type, " ", "")) %>%
mutate(management_type = str_replace_all(management_type, "shelters", "")) %>%
mutate(management_type = str_replace_all(management_type, "banners", "")) %>%
mutate(management_type = str_replace_all(management_type, ",,", ",")) %>%
mutate(sign_access = ifelse(str_detect(management_type, "signaccess"), 1, 0)) %>%
mutate(sign_nest = ifelse(str_detect(management_type, "signnest"), 1, 0)) %>%
mutate(rope_fence = ifelse(str_detect(management_type, "ropefence"), 1, 0)) %>%
mutate(wardens = ifelse(str_detect(management_type, "wardens"), 1, 0)) %>%
mutate(none = ifelse(str_detect(management_type, "none"), 1, 0)) %>%
mutate(other = ifelse(str_detect(management_type, "other"), 1, 0)) %>%
mutate(management_level = ifelse(sign_access == 1 & sign_nest == 1 & rope_fence == 1 & wardens == 1, 4,
ifelse(rope_fence == 1, 3,
ifelse(sign_nest == 1, 2,
ifelse(sign_access == 1, 1,
ifelse(none == 1, 0, NA)))))) %>%
mutate(sign_nest_no_sign_access = ifelse(sign_access == 0 & sign_nest == 1, 1, 0)) %>%
mutate(fence_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & rope_fence == 1, 1, 0)) %>%
mutate(wardens_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & wardens == 1, 1, 0)) %>%
mutate(wardens_no_fence = ifelse(rope_fence == 1 & wardens == 1, 1, 0)) %>%
mutate(just_wardens = ifelse(rope_fence == 0 & sign_access == 0 & sign_nest == 0 & wardens == 1, 1, 0)) %>%
dplyr::select(-other, -sign_nest_no_sign_access, -fence_no_sign,
-wardens_no_sign, -wardens_no_fence, -just_wardens) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
mutate(region = "FP") %>%
mutate(site = as.factor(site)) %>%
mutate(issue1 = ifelse(nchar(first_found) != 8, "found date is not 8 characters; ", NA)) %>%
mutate(issue2 = ifelse(nchar(last_alive) != 8, "last seen alive date is not 8 characters; ", NA)) %>%
mutate(issue3 = ifelse(nchar(last_checked) != 8, "last checked date is not 8 characters; ", NA)) %>%
mutate(issue4 = ifelse(is.na(first_found), "found date missing; ", NA)) %>%
mutate(issue5 = ifelse(is.na(last_alive), "last seen alive date missing; ", NA)) %>%
mutate(issue6 = ifelse(is.na(last_checked), "last checked date missing; ", NA)) %>%
mutate(issue7 = ifelse(management_status %!in% c("Y", "N"), "Nest managed? is not Y or N; ", NA)) %>%
mutate(issue8 = ifelse(nest_hab %!in% c("Beach", "Dune", "Foredune/face", "Estuary/spit", "Rocks"), "Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks; ", NA)) %>%
mutate(issue9 = ifelse(is.na(management_level), "Management type is not sufficient for making levels; ", NA)) %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
mutate(issue10 = ifelse(found_and_alive_diff > 35 , "Double check dates because incuabation time greater than 35 days; ", NA)) %>%
mutate(issue11 = ifelse(FirstFound > LastPresent, "Found date is after Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issue12 = ifelse(FirstFound > LastChecked, "Found date is after Last Checked date (should be greater or equal); ", NA)) %>%
mutate(issue13 = ifelse(LastChecked < LastPresent, "Last Checked date is before Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issues = ifelse(is.na(issue1) & is.na(issue2) & is.na(issue3) &
is.na(issue4) & is.na(issue5) & is.na(issue6) &
is.na(issue7) & is.na(issue8) & is.na(issue9) &
is.na(issue10) & is.na(issue11) & is.na(issue12) & is.na(issue13), NA,
paste0(issue1, issue2, issue3,
issue4, issue5, issue6,
issue7, issue8, issue9,
issue10, issue11, issue12, issue13))) %>%
mutate(issues = str_remove_all(issues, "NA")) %>%
mutate(issues = ifelse(is.na(issues), "usable", issues)) %>%
dplyr::select(-issue1, -issue2, -issue3,
-issue4, -issue5, -issue6,
-issue7, -issue8, -issue9,
-issue10, -issue11, -issue12, -issue13) %>%
filter(issues != "usable") %>%
arrange(issues) %>%
filter(first_found != "Not found" & last_alive != "Not seen" & last_checked != "Not seen" & last_checked != "Not revisited" & last_checked != "Not revisted") %>%
filter(str_detect(issues, "date")) %>%
mutate(issues = str_remove_all(issues, "Management type is not sufficient for making levels; ")) %>%
dplyr::select(season, nest_ID, first_found, first_found2, last_alive, last_alive2, last_checked, last_checked2, Fate, found_and_alive_diff, issues) %>%
datatable(class = 'cell-border stripe', rownames = FALSE, filter = 'top')#%>%Code
# write_csv(., "data/final/final_final/nest_issues_commented/FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data_nests_w_issues_commented.csv", col_names = TRUE, append = FALSE, quote = "all")Import data
Code
nest_data_FP <-
bind_rows(
lucinda_nest_import(year_1 = "2020", year_2 = "2021",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2019", year_2 = "2020",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2018", year_2 = "2019",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2017", year_2 = "2018",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2016", year_2 = "2017",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2015", year_2 = "2016",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2014", year_2 = "2015",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2013", year_2 = "2014",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2012", year_2 = "2013",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2011", year_2 = "2012",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2010", year_2 = "2011",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36),
lucinda_nest_import(year_1 = "2009", year_2 = "2010",
file_name = "FP Nesting summary 2020_21 to 2009_10 FINAL- checking names consistent for threat data.xlsx", site = "FP", extra_text = " Nest summary",
first_found_date_col = 10,
last_alive_date_col = 29,
last_checked_col = 36)) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
filter(!is.na(FirstFound) & !is.na(LastPresent) & !is.na(LastChecked)) %>%
filter(management_status %in% c("Y", "N")) %>%
filter(nest_hab %in% c("Beach", "Dune", "Foredune/face")) %>%
filter(!is.na(management_level)) %>%
mutate(region = "FP") %>%
mutate(site = as.factor(site))Visual inspections of data
Code
nest_data_FP_check <-
nest_data_FP %>%
ungroup() %>%
mutate(first_found2_md = paste(format(first_found2 + 180, format = "%m"),
format(first_found2 + 180, format = "%d"),
sep = "-"),
last_alive2_md = paste(format(last_alive2 + 180, format = "%m"),
format(last_alive2 + 180, format = "%d"),
sep = "-"),
last_checked2_md = paste(format(last_checked2 + 180, format = "%m"),
format(last_checked2 + 180, format = "%d"),
sep = "-")) %>%
mutate(first_found2_trans = as.Date(paste("2020", first_found2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_alive2_trans = as.Date(paste("2020", last_alive2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_checked2_trans = as.Date(paste("2020", last_checked2_md, sep = "-"), format = "%Y-%m-%d") - 179) %>%
mutate(season_label = paste0("season ", str_sub(season, 1, 4), " to ", str_sub(season, 5, 6)))Spatial distribution of data
Note that this map only shows data that are in a decimal degrees format (e.g., -38.31), NOT degree minute seconds (e.g., 38 27.59). The map is interactive, so click on an outlier to see its metadata
Code
nest_data_FP %>%
mutate(nest_lon = as.numeric(nest_lon),
nest_lat = as.numeric(nest_lat)) %>%
filter(!is.na(nest_lon) & !is.na(nest_lat)) %>%
st_as_sf(coords = c("nest_lon", "nest_lat"),
crs = 4326) %>%
mapview(popup = popupTable(.,
zcol = c("season",
"site",
"nest_ID")))Year-specific Found Date Distributions
Code
ggplot(nest_data_FP_check, aes(first_found2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_FP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_FP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Found date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Alive Date Distributions
Code
ggplot(nest_data_FP_check, aes(last_alive2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_FP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_FP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last alive date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Checked Date Distributions
Code
ggplot(nest_data_FP_check, aes(last_checked2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_FP_check$first_found2_trans, na.rm = TRUE),
max(nest_data_FP_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last checked date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Incubation length distribution
Code
# assess if there are nests with unusually long incubation periods
nest_data_FP_check %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
filter(FirstFound < LastPresent & FirstFound < LastChecked) %>%
ggplot() +
geom_histogram(aes(found_and_alive_diff)) +
luke_theme +
xlab("Time between found date and last alive date (days)") +
ylab("Frquency of nests")
Date issues
Code
# check if there are any data in which the last alive date is a) beyond the nocc, b) less than 1, or c) NA
filter(nest_data_FP, LastPresent > nocc | LastPresent < 1 | is.na(LastPresent)) # should be nothing if correct# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# check if there are any data in which the found date is a) beyond the nocc, or b) less than 1
filter(nest_data_FP, FirstFound > nocc | FirstFound < 1) # should be nothing if correct# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# check if there are any data in which the found date is a) after the last alive or b) after the last checked date
filter(nest_data_FP, FirstFound > LastPresent | FirstFound > LastChecked) # should be nothing if correct# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Bellarine / Surf Coast
Flag potential issues in data
As above, first we import the data and run a few checks to assess if there are any rows with the issues listed above
Code
suppressMessages(bind_rows(
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2020", "_", str_sub("2021", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2019", "_", str_sub("2020", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2018", "_", str_sub("2019", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2017", "_", str_sub("2018", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2016", "_", str_sub("2017", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2015", "_", str_sub("2016", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2014", "_", str_sub("2015", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2013", "_", str_sub("2014", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2012", "_", str_sub("2013", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2011", "_", str_sub("2012", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2010", "_", str_sub("2011", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2009", "_", str_sub("2010", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2008", "_", str_sub("2009", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2007", "_", str_sub("2008", 3, 4)),
col_types = "text", na = "n/a"),
read_excel(paste0("data/final/final_final/", "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx"),
sheet = paste0("BellSurfCoast", " ", "2006", "_", str_sub("2007", 3, 4)),
col_types = "text", na = "n/a"))) %>%
rename(first_found = 10,
last_alive = 29,
last_checked = 36,
Fate = `Hatch?`,
season = Season,
site = Site,
nest_ID = `Nest ID`,
nest_hab = `Nest habitat`,
management_status = `Nest managed?`,
management_type = `Management type`,
nest_lat = `Nest latitude`,
nest_lon = `Nest longitude`) %>%
dplyr::select(season, site, nest_ID, first_found, last_alive, last_checked, Fate, nest_hab,
management_status, management_type, nest_lat, nest_lon, site) %>%
mutate(last_alive = ifelse(str_detect(last_alive, "Unk."), NA, last_alive),
Fate = ifelse(Fate == "Y", 0, 1)) %>%
mutate(
last_checked = ifelse(!is.na(last_alive) & is.na(last_checked),
last_alive,
ifelse(is.na(last_alive) & is.na(last_checked),
first_found,
last_checked))) %>%
mutate(
last_alive = ifelse(is.na(last_alive) & Fate == "0" & !is.na(last_checked),
last_checked,
ifelse(is.na(last_alive) & Fate == "1" & !is.na(last_checked),
first_found,
last_alive))) %>%
mutate(first_found2 = as.Date(paste(str_sub(first_found, 5, 8),
str_sub(first_found, 3, 4),
str_sub(first_found, 1, 2), sep = "-")),
last_alive2 = as.Date(paste(str_sub(last_alive, 5, 8),
str_sub(last_alive, 3, 4),
str_sub(last_alive, 1, 2), sep = "-")),
last_checked2 = as.Date(paste(str_sub(last_checked, 5, 8),
str_sub(last_checked, 3, 4),
str_sub(last_checked, 1, 2), sep = "-"))) %>%
mutate(FirstFound = as.numeric(format(first_found2 + 180, "%j")),
LastPresent = as.numeric(format(last_alive2 + 180, "%j")),
LastChecked = as.numeric(format(last_checked2 + 180, "%j"))) %>%
mutate(management_type = tolower(management_type)) %>%
mutate(management_type = str_replace(management_type, "acess", "access")) %>%
mutate(management_type = str_replace(management_type, "and", ",")) %>%
mutate(management_type = str_replace(management_type, "temporary", "")) %>%
mutate(management_type = str_replace_all(management_type, " ", "")) %>%
mutate(management_type = str_replace_all(management_type, "shelters", "")) %>%
mutate(management_type = str_replace_all(management_type, "banners", "")) %>%
mutate(management_type = str_replace_all(management_type, ",,", ",")) %>%
mutate(sign_access = ifelse(str_detect(management_type, "signaccess"), 1, 0)) %>%
mutate(sign_nest = ifelse(str_detect(management_type, "signnest"), 1, 0)) %>%
mutate(rope_fence = ifelse(str_detect(management_type, "ropefence"), 1, 0)) %>%
mutate(wardens = ifelse(str_detect(management_type, "wardens"), 1, 0)) %>%
mutate(none = ifelse(str_detect(management_type, "none"), 1, 0)) %>%
mutate(other = ifelse(str_detect(management_type, "other"), 1, 0)) %>%
mutate(management_level = ifelse(sign_access == 1 & sign_nest == 1 & rope_fence == 1 & wardens == 1, 4,
ifelse(rope_fence == 1, 3,
ifelse(sign_nest == 1, 2,
ifelse(sign_access == 1, 1,
ifelse(none == 1, 0, NA)))))) %>%
mutate(sign_nest_no_sign_access = ifelse(sign_access == 0 & sign_nest == 1, 1, 0)) %>%
mutate(fence_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & rope_fence == 1, 1, 0)) %>%
mutate(wardens_no_sign = ifelse((sign_access == 0 & sign_nest == 0) & wardens == 1, 1, 0)) %>%
mutate(wardens_no_fence = ifelse(rope_fence == 1 & wardens == 1, 1, 0)) %>%
mutate(just_wardens = ifelse(rope_fence == 0 & sign_access == 0 & sign_nest == 0 & wardens == 1, 1, 0)) %>%
dplyr::select(-other, -sign_nest_no_sign_access, -fence_no_sign,
-wardens_no_sign, -wardens_no_fence, -just_wardens) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
mutate(region = "BellSurfCoast") %>%
mutate(site = as.factor(site)) %>%
mutate(issue1 = ifelse(nchar(first_found) != 8, "found date is not 8 characters; ", NA)) %>%
mutate(issue2 = ifelse(nchar(last_alive) != 8, "last seen alive date is not 8 characters; ", NA)) %>%
mutate(issue3 = ifelse(nchar(last_checked) != 8, "last checked date is not 8 characters; ", NA)) %>%
mutate(issue4 = ifelse(is.na(first_found), "found date missing; ", NA)) %>%
mutate(issue5 = ifelse(is.na(last_alive), "last seen alive date missing; ", NA)) %>%
mutate(issue6 = ifelse(is.na(last_checked), "last checked date missing; ", NA)) %>%
mutate(issue7 = ifelse(management_status %!in% c("Y", "N"), "Nest managed? is not Y or N; ", NA)) %>%
mutate(issue8 = ifelse(nest_hab %!in% c("Beach", "Dune", "Foredune/face", "Estuary/spit", "Rocks"), "Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks; ", NA)) %>%
mutate(issue9 = ifelse(is.na(management_level), "Management type is not sufficient for making levels; ", NA)) %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
mutate(issue10 = ifelse(found_and_alive_diff > 35 , "Double check dates because incuabation time greater than 35 days; ", NA)) %>%
mutate(issue11 = ifelse(FirstFound > LastPresent, "Found date is after Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issue12 = ifelse(FirstFound > LastChecked, "Found date is after Last Checked date (should be greater or equal); ", NA)) %>%
mutate(issue13 = ifelse(LastChecked < LastPresent, "Last Checked date is before Last Alive date (should be greater or equal); ", NA)) %>%
mutate(issues = ifelse(is.na(issue1) & is.na(issue2) & is.na(issue3) &
is.na(issue4) & is.na(issue5) & is.na(issue6) &
is.na(issue7) & is.na(issue8) & is.na(issue9) &
is.na(issue10) & is.na(issue11) & is.na(issue12) & is.na(issue13), NA,
paste0(issue1, issue2, issue3,
issue4, issue5, issue6,
issue7, issue8, issue9,
issue10, issue11, issue12, issue13))) %>%
mutate(issues = str_remove_all(issues, "NA")) %>%
mutate(issues = ifelse(is.na(issues), "usable", issues)) %>%
dplyr::select(-issue1, -issue2, -issue3,
-issue4, -issue5, -issue6,
-issue7, -issue8, -issue9,
-issue10, -issue11, -issue12, -issue13) %>%
filter(issues != "usable") %>%
arrange(issues) %>%
filter(first_found != "Not found" & last_alive != "Not seen" & last_checked != "Not seen" & last_checked != "Not revisited" & last_checked != "Not revisted") %>%
filter(str_detect(issues, "date")) %>%
mutate(issues = str_remove_all(issues, "Management type is not sufficient for making levels; ")) %>%
mutate(issues = str_remove_all(issues, "Nest habitat is not Beach, Dune, Foredune/face, Estuary/spit, or Rocks; ")) %>%
dplyr::select(season, nest_ID, first_found, first_found2, last_alive, last_alive2, last_checked, last_checked2, Fate, found_and_alive_diff, issues) %>%
datatable(class = 'cell-border stripe', rownames = FALSE, filter = 'top')#%>%Code
# write_csv(., "data/final/final_final/nest_issues_commented/Bellarine_Surf Coast Nesting with site names matching with threat data doc_nests_w_issues_commented.csv", col_names = TRUE, append = FALSE, quote = "all")Import data
Code
nest_data_BSC <-
bind_rows(
lucinda_nest_import(year_1 = "2020", year_2 = "2021",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2019", year_2 = "2020",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2018", year_2 = "2019",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2017", year_2 = "2018",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2016", year_2 = "2017",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2015", year_2 = "2016",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2014", year_2 = "2015",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2013", year_2 = "2014",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2012", year_2 = "2013",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2011", year_2 = "2012",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2010", year_2 = "2011",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2009", year_2 = "2010",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2008", year_2 = "2009",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2007", year_2 = "2008",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
lucinda_nest_import(year_1 = "2006", year_2 = "2007",
first_found_date_col = 10, last_alive_date_col = 29, last_checked_col = 36,
file_name = "Bellarine_Surf Coast Nesting with site names matching with threat data doc.xlsx", site = "BellSurfCoast"),
) %>%
group_by(season) %>%
mutate(nocc = max(max(LastChecked, na.rm = TRUE), max(LastPresent, na.rm = TRUE)),
season = as.factor(season),
nest_hab = as.factor(nest_hab),
management_status = as.factor(management_status)) %>%
filter(!is.na(FirstFound) & !is.na(LastPresent) & !is.na(LastChecked)) %>%
filter(management_status %in% c("Y", "N")) %>%
filter(nest_hab %in% c("Beach", "Dune", "Foredune/face")) %>%
filter(!is.na(management_level)) %>%
mutate(region = "BSC") %>%
mutate(site = as.factor(site))Visual inspections of data
Code
nest_data_BSC_check <-
nest_data_BSC %>%
ungroup() %>%
mutate(first_found2_md = paste(format(first_found2 + 180, format = "%m"),
format(first_found2 + 180, format = "%d"),
sep = "-"),
last_alive2_md = paste(format(last_alive2 + 180, format = "%m"),
format(last_alive2 + 180, format = "%d"),
sep = "-"),
last_checked2_md = paste(format(last_checked2 + 180, format = "%m"),
format(last_checked2 + 180, format = "%d"),
sep = "-")) %>%
mutate(first_found2_trans = as.Date(paste("2020", first_found2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_alive2_trans = as.Date(paste("2020", last_alive2_md, sep = "-"), format = "%Y-%m-%d") - 179,
last_checked2_trans = as.Date(paste("2020", last_checked2_md, sep = "-"), format = "%Y-%m-%d") - 179) %>%
mutate(season_label = paste0("season ", str_sub(season, 1, 4), " to ", str_sub(season, 5, 6)))Spatial distribution of data
Note that this map only shows data that are in a decimal degrees format (e.g., -38.31), NOT degree minute seconds (e.g., 38 27.59). The map is interactive, so click on an outlier to see its metadata
Code
nest_data_BSC %>%
mutate(nest_lon = as.numeric(nest_lon),
nest_lat = as.numeric(nest_lat)) %>%
filter(!is.na(nest_lon) & !is.na(nest_lat)) %>%
st_as_sf(coords = c("nest_lon", "nest_lat"),
crs = 4326) %>%
mapview(popup = popupTable(.,
zcol = c("season",
"site",
"nest_ID")))Year-specific Found Date Distributions
Code
ggplot(nest_data_BSC_check, aes(first_found2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_BSC_check$first_found2_trans, na.rm = TRUE),
max(nest_data_BSC_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
# scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Found date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Alive Date Distributions
Code
ggplot(nest_data_BSC_check, aes(last_alive2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_BSC_check$first_found2_trans, na.rm = TRUE),
max(nest_data_BSC_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
# scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last alive date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Year-specific Last Checked Date Distributions
Code
ggplot(nest_data_BSC_check, aes(last_checked2_trans, fill = as.factor(Fate))) +
geom_histogram(bins = 30,
alpha = 0.8, color = "white", linewidth = 0.2) +
scale_fill_manual(values = c("0" = brewer.pal(8, "Set1")[c(1)], "1" = brewer.pal(8, "Set1")[c(2)]),
name = "Nest Fate",
labels = c("Failed", "Hatched")) +
ylab("weekly number of nests") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_data_BSC_check$first_found2_trans, na.rm = TRUE),
max(nest_data_BSC_check$last_checked2_trans, na.rm = TRUE))) +
facet_wrap("season_label") +
# scale_y_continuous(limits = c(0, 10), breaks = c(2, 4, 6, 8, 10, 12)) +
luke_theme +
xlab("Last checked date") +
theme(legend.position = c(0.85, 0.05),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5))
Incubation length distribution
Code
# assess if there are nests with unusually long incubation periods
nest_data_BSC_check %>%
mutate(found_and_alive_diff = last_alive2 - first_found2) %>%
filter(FirstFound < LastPresent & FirstFound < LastChecked) %>%
ggplot() +
geom_histogram(aes(found_and_alive_diff)) +
luke_theme +
xlab("Time between found date and last alive date (days)") +
ylab("Frquency of nests")
Date issues
Code
# check if there are any data in which the last alive date is a) beyond the nocc, b) less than 1, or c) NA
filter(nest_data_BSC, LastPresent > nocc | LastPresent < 1 | is.na(LastPresent)) # should be nothing if correct# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# check if there are any data in which the found date is a) beyond the nocc, or b) less than 1
filter(nest_data_BSC, FirstFound > nocc | FirstFound < 1) # should be nothing if correct# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# check if there are any data in which the found date is a) after the last alive or b) after the last checked date
filter(nest_data_BSC, FirstFound > LastPresent | FirstFound > LastChecked) # should be nothing if correct# A tibble: 1 × 26
# Groups: season [1]
season site nest_ID first_found last_alive last_checked Fate nest_hab
<fct> <fct> <chr> <chr> <chr> <chr> <dbl> <fct>
1 200809 50W to Poin… 200809… 10122008 12102008 12102008 0 Dune
# ℹ 18 more variables: management_status <fct>, management_type <chr>,
# nest_lat <chr>, nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, region <chr>Importing and checking threat data
Code
FP_threat_data <-
read_excel("data/final/final_final/Merged threat data_FP_MP.xlsx",
sheet = "FP Threat DATA",
col_types = "text") %>%
mutate(season = str_remove(Season, "/")) %>%
filter(Region %in% c("Fleurieu Peninsula")) %>%
rename(obs_lon = `Observation Longitude`,
obs_lat = `Observation Latitude`,
obs_date = `Observation Date`) %>%
mutate(obs_date = as.Date(as.numeric(obs_date),
origin = "1899-12-30")) %>%
mutate(obs_date2 = as.numeric(format(obs_date + 180, "%j"))) %>%
mutate(region = "FP")
MP_threat_data <-
read_excel("data/final/final_final/Merged threat data_FP_MP.xlsx",
sheet = "MP Threat DATA",
col_types = "text") %>%
mutate(season = str_remove(Season, "/")) %>%
filter(Region %in% c("Mornington Peninsula")) %>%
rename(obs_lon = `Observation Longitude`,
obs_lat = `Observation Latitude`,
obs_date = `Observation Date`) %>%
mutate(obs_date = as.Date(as.numeric(obs_date),
origin = "1899-12-30")) %>%
mutate(obs_date2 = as.numeric(format(obs_date + 180, "%j"))) %>%
mutate(region = "MP")
BSC_threat_data <-
read_excel("data/final/final_final/Merged threat data_BSC.xlsx",
sheet = "BellSurf Threat DATA",
col_types = "text") %>%
mutate(season = str_remove(Season, "/")) %>%
rename(obs_lon = `Observation Longitude`,
obs_lat = `Observation Latitude`,
obs_date = `Observation date`) %>%
mutate(obs_date = as.Date(as.numeric(obs_date),
origin = "1899-12-30")) %>%
mutate(obs_date2 = as.numeric(format(obs_date + 180, "%j"))) %>%
mutate(region = "BSC")
threat_data <-
bind_rows(FP_threat_data, MP_threat_data, BSC_threat_data)Code
threat_data_ <-
threat_data %>%
rename(site = `Site name`) %>%
# first convert all the count columns to numeric
mutate_at(vars(
`Walkers/Joggers (wet sand)`,`Walkers/Joggers (dry sand)`,
`Walkers/Joggers (signs/fence)`,`Walkers/Joggers (Dune)`,`People sunbaking/sitting (wet sand)`,
`People sunbaking/sitting (dry sand)`,`People sunbaking/sitting (signs/fence)`,
`People sunbaking/sitting (Dune)`,`Surfers/Swimmers (wet sand)`,
`Surfers/Swimmers (dry sand)`,`Surfers/Swimmers (signs/fence)`,
`Surfers/Swimmers (Dune)`,`People Fishing (wet sand)`,
`People Fishing (dry sand)`,`People Fishing (signs/fence)`,
`People Fishing (Dune)`,`People Playing Games (wet sand)`,
`People Playing Games (dry sand)`,`People Playing Games (signs/fence)`,
`People Playing Games (Dune)`,`Dog Walkers (wet sand)`,
`Dog Walkers (dry sand)`,`Dog Walkers (signs/fence)`,
`Dog Walkers (Dune)`,`Dog On Leash (# dogs) (wet sand)`,
`Dog On Leash (# dogs) (dry sand)`,`Dog On Leash (# dogs) (signs/fence)`,
`Dog On Leash (# dogs) (Dune)`,`Dog Off Leash (# dogs) (wet sand)`,
`Dog Off Leash (# dogs) (dry sand)`,`Dog Off Leash (# dogs) (signs/fence)`,
`Dog Off Leash (# dogs) (Dune)`,`Horses (wet sand)`,
`Horses (dry sand)`,`Horses (signs/fence)`,
`Horses (Dune)`,`Permitted vehicle (wet sand)`,
`Permitted vehicle (dry sand)`,`Permitted vehicle (signs/fence)`,
`Permitted vehicle (Dune)`,`Illegal vehicle (wet sand)`,
`Illegal vehicle (dry sand)`,`Illegal vehicle (signs/fence)`,
`Illegal vehicle (Dune)`,`Ravens (wet sand)`,
`Ravens (dry sand)`,`Ravens (signs/fence)`,
`Ravens (Dune)`,`Magpies (wet sand)`,
`Magpies (dry sand)`,`Magpies (signs/fence)`,
`Magpies (Dune)`,`Silver Gulls (wet sand)`,
`Silver Gulls (dry sand)`,`Silver Gulls (signs/fence)`,
`Silver Gulls (Dune)`,`Pacific/Kelp Gulls (wet sand)`,
`Pacific/Kelp Gulls (dry sand)`,`Pacific/Kelp Gulls (signs/fence)`,
`Pacific/Kelp Gulls (Dune)`,`Nankeen Kestrels (wet sand)`,
`Nankeen Kestrels (dry sand)`,`Nankeen Kestrels (signs/fence)`,
`Nankeen Kestrels (Dune)`,`Other bird of prey (wet sand)`,
`Other bird of prey (dry sand)`,`Other bird of prey (signs/fence)`,
`Other bird of prey (Dune)`,
`Stock (cattle/sheep) (wet sand)`,
`Stock (cattle/sheep) (dry sand)`,`Stock (cattle/sheep) (signs/fence)`,
`Stock (cattle/sheep) (Dune)`), as.numeric) %>%
ungroup() %>%
# take the total sum of counts for each threat type (e.g., humans includes
# Dog Walkers, People Playing Games, People Fishing, Surfers/Swimmers,
# People sunbaking/sitting, and Walkers/Joggers)
mutate(humans = rowSums(dplyr::select(.,`Walkers/Joggers (wet sand)`,
`Walkers/Joggers (dry sand)`,
`Walkers/Joggers (signs/fence)`,
`Walkers/Joggers (Dune)`,
`People sunbaking/sitting (wet sand)`,
`People sunbaking/sitting (dry sand)`,
`People sunbaking/sitting (signs/fence)`,
`People sunbaking/sitting (Dune)`,
`Surfers/Swimmers (wet sand)`,
`Surfers/Swimmers (dry sand)`,
`Surfers/Swimmers (signs/fence)`,
`Surfers/Swimmers (Dune)`,
`People Fishing (wet sand)`,
`People Fishing (dry sand)`,
`People Fishing (signs/fence)`,
`People Fishing (Dune)`,
`People Playing Games (wet sand)`,
`People Playing Games (dry sand)`,
`People Playing Games (signs/fence)`,
`People Playing Games (Dune)`,
`Dog Walkers (wet sand)`,
`Dog Walkers (dry sand)`,
`Dog Walkers (signs/fence)`,
`Dog Walkers (Dune)`), na.rm = TRUE),
# do a micro-habitat specific sum for humans
humans_wet = rowSums(dplyr::select(.,`Walkers/Joggers (wet sand)`,
`People sunbaking/sitting (wet sand)`,
`Surfers/Swimmers (wet sand)`,
`People Fishing (wet sand)`,
`People Playing Games (wet sand)`,
`Dog Walkers (wet sand)`), na.rm = TRUE),
humans_dry = rowSums(dplyr::select(.,`Walkers/Joggers (dry sand)`,
`People sunbaking/sitting (dry sand)`,
`Surfers/Swimmers (dry sand)`,
`People Fishing (dry sand)`,
`People Playing Games (dry sand)`,
`Dog Walkers (dry sand)`), na.rm = TRUE),
humans_dune = rowSums(dplyr::select(.,`Walkers/Joggers (Dune)`,
`People sunbaking/sitting (Dune)`,
`Surfers/Swimmers (Dune)`,
`People Fishing (Dune)`,
`People Playing Games (Dune)`,
`Dog Walkers (Dune)`), na.rm = TRUE),
humans_SF = rowSums(dplyr::select(.,`Walkers/Joggers (signs/fence)`,
`People sunbaking/sitting (signs/fence)`,
`Surfers/Swimmers (signs/fence)`,
`People Fishing (signs/fence)`,
`People Playing Games (signs/fence)`,
`Dog Walkers (signs/fence)`), na.rm = TRUE),
dogs = rowSums(dplyr::select(., `Dog On Leash (# dogs) (wet sand)`,
`Dog On Leash (# dogs) (dry sand)`,
`Dog On Leash (# dogs) (signs/fence)`,
`Dog On Leash (# dogs) (Dune)`,
`Dog Off Leash (# dogs) (wet sand)`,
`Dog Off Leash (# dogs) (dry sand)`,
`Dog Off Leash (# dogs) (signs/fence)`,
`Dog Off Leash (# dogs) (Dune)`), na.rm = TRUE),
# specify a dog on leash and a dog of leash summary
dogs_on = rowSums(dplyr::select(., `Dog On Leash (# dogs) (wet sand)`,
`Dog On Leash (# dogs) (dry sand)`,
`Dog On Leash (# dogs) (signs/fence)`,
`Dog On Leash (# dogs) (Dune)`), na.rm = TRUE),
dogs_off = rowSums(dplyr::select(., `Dog Off Leash (# dogs) (wet sand)`,
`Dog Off Leash (# dogs) (dry sand)`,
`Dog Off Leash (# dogs) (signs/fence)`,
`Dog Off Leash (# dogs) (Dune)`), na.rm = TRUE),
pred_birds = rowSums(dplyr::select(., `Ravens (wet sand)`,
`Ravens (dry sand)`,
`Ravens (signs/fence)`,
`Ravens (Dune)`,
`Magpies (wet sand)`,
`Magpies (dry sand)`,
`Magpies (signs/fence)`,
`Magpies (Dune)`,
`Silver Gulls (wet sand)`,
`Silver Gulls (dry sand)`,
`Silver Gulls (signs/fence)`,
`Silver Gulls (Dune)`,
`Pacific/Kelp Gulls (wet sand)`,
`Pacific/Kelp Gulls (dry sand)`,
`Pacific/Kelp Gulls (signs/fence)`,
`Pacific/Kelp Gulls (Dune)`,
`Nankeen Kestrels (wet sand)`,
`Nankeen Kestrels (dry sand)`,
`Nankeen Kestrels (signs/fence)`,
`Nankeen Kestrels (Dune)`,
`Other bird of prey (wet sand)`,
`Other bird of prey (dry sand)`,
`Other bird of prey (signs/fence)`,
`Other bird of prey (Dune)`), na.rm = TRUE),
vehicles = rowSums(dplyr::select(., `Permitted vehicle (wet sand)`,
`Permitted vehicle (dry sand)`,
`Permitted vehicle (signs/fence)`,
`Permitted vehicle (Dune)`,
`Illegal vehicle (wet sand)`,
`Illegal vehicle (dry sand)`,
`Illegal vehicle (signs/fence)`,
`Illegal vehicle (Dune)`), na.rm = TRUE),
hoofed_animals = rowSums(dplyr::select(.,`Horses (wet sand)`,
`Horses (dry sand)`,
`Horses (signs/fence)`,
`Horses (Dune)`,
`Stock (cattle/sheep) (wet sand)`,
`Stock (cattle/sheep) (dry sand)`,
`Stock (cattle/sheep) (signs/fence)`,
`Stock (cattle/sheep) (Dune)`), na.rm = TRUE)) %>%
# consolidate columns names
rename(hum_pri_wet = `Human Prints (wet sand)`,
hum_pri_dry = `Human Prints (dry sand)`,
hum_pri_dune = `Human Prints (Dune)`,
hum_pri_SF = `Human Prints (signs/fence)`,
fox_pri_wet = `Fox Prints (wet sand)`,
fox_pri_dry = `Fox Prints (dry sand)`,
fox_pri_dune = `Fox Prints (Dune)`,
fox_pri_SF = `Fox Prints (signs/fence)`,
dog_pri_wet = `Dog Prints (wet sand)`,
dog_pri_dry = `Dog Prints (dry sand)`,
dog_pri_dune = `Dog Prints (Dune)`,
dog_pri_SF = `Dog Prints (signs/fence)`,
vehicle_pri_wet = `Vehicle Tracks (wet sand)`,
vehicle_pri_dry = `Vehicle Tracks (dry sand)`,
vehicle_pri_dune = `Vehicle Tracks (Dune)`,
vehicle_pri_SF = `Vehicle Tracks (signs/fence)`,
trailbike_pri_wet = `Trail bike tracks (wet sand)`,
trailbike_pri_dry = `Trail bike tracks (dry sand)`,
trailbike_pri_dune = `Trail bike tracks (Dune)`,
trailbike_pri_SF = `Trail bike tracks (signs/fence)`,
stock_pri_wet = `Stock (wet sand)`,
stock_pri_dry = `Stock (dry sand)`,
stock_pri_dune = `Stock (Dune)`,
stock_pri_SF = `Stock (signs/fence)`,
horse_pri_wet = `Horses Prints (wet sand)`,
horse_pri_dry = `Horses Prints (dry sand)`,
horse_pri_dune = `Horses Prints (Dune)`,
horse_pri_SF = `Horses Prints (signs/fence)`) %>%
# specify coordinates as numeric
mutate(obs_lon = as.numeric(obs_lon),
obs_lat = as.numeric(obs_lat)) %>%
# clean up factor levels (e.g., sometime "Light", sometimes just "L")
mutate(hum_pri_wet = ifelse(hum_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(hum_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
hum_pri_dry = ifelse(hum_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(hum_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
hum_pri_SF = ifelse(hum_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(hum_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
hum_pri_dune = ifelse(hum_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(hum_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
fox_pri_wet = ifelse(fox_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(fox_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
fox_pri_dry = ifelse(fox_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(fox_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
fox_pri_SF = ifelse(fox_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(fox_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
fox_pri_dune = ifelse(fox_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(fox_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
dog_pri_wet = ifelse(dog_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(dog_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
dog_pri_dry = ifelse(dog_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(dog_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
dog_pri_SF = ifelse(dog_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(dog_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
dog_pri_dune = ifelse(dog_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(dog_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
vehicle_pri_wet = ifelse(vehicle_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(vehicle_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
vehicle_pri_dry = ifelse(vehicle_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(vehicle_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
vehicle_pri_SF = ifelse(vehicle_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(vehicle_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
vehicle_pri_dune = ifelse(vehicle_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(vehicle_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
trailbike_pri_wet = ifelse(trailbike_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(trailbike_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
trailbike_pri_dry = ifelse(trailbike_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(trailbike_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
trailbike_pri_SF = ifelse(trailbike_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(trailbike_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
trailbike_pri_dune = ifelse(trailbike_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(trailbike_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
horse_pri_wet = ifelse(horse_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(horse_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
horse_pri_dry = ifelse(horse_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(horse_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
horse_pri_SF = ifelse(horse_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(horse_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
horse_pri_dune = ifelse(horse_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(horse_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
stock_pri_wet = ifelse(stock_pri_wet %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(stock_pri_wet, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
stock_pri_dry = ifelse(stock_pri_dry %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(stock_pri_dry, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
stock_pri_SF = ifelse(stock_pri_SF %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(stock_pri_SF, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H")),
stock_pri_dune = ifelse(stock_pri_dune %in% c("Light", "Moderate", "Heavy", "L", "M", "H"),
substr(stock_pri_dune, 1, 1), NA) %>% as.factor(.) %>% factor(., levels = c("L", "M", "H"))) %>%
# to control for multiple threat surveys per date, summarise by date
group_by(region, site, season, obs_date, obs_date2) %>%
summarise(obs_lon = mean(obs_lon, na.rm = TRUE),
obs_lat = mean(obs_lat, na.rm = TRUE),
# in the case of multiple surveys on a single date at a specific
# site, take the max humans counted, etc., and the highest level of
# prints, etc.
humans = max(humans, na.rm = TRUE),
humans_wet = max(humans_wet, na.rm = TRUE),
humans_dry = max(humans_dry, na.rm = TRUE),
humans_dune = max(humans_dune, na.rm = TRUE),
humans_SF = max(humans_SF, na.rm = TRUE),
hoofed_animals = max(hoofed_animals, na.rm = TRUE),
vehicles = max(vehicles, na.rm = TRUE),
pred_birds = max(pred_birds, na.rm = TRUE),
dogs_off = max(dogs_off, na.rm = TRUE),
dogs_on = max(dogs_on, na.rm = TRUE),
dogs = max(dogs, na.rm = TRUE),
hum_pri_wet = ifelse(all(is.na(hum_pri_wet)), NA,
levels(hum_pri_wet)[max(as.integer(hum_pri_wet), na.rm = TRUE)]),
hum_pri_dry = ifelse(all(is.na(hum_pri_dry)), NA,
levels(hum_pri_dry)[max(as.integer(hum_pri_dry), na.rm = TRUE)]),
hum_pri_dune = ifelse(all(is.na(hum_pri_dune)), NA,
levels(hum_pri_dune)[max(as.integer(hum_pri_dune), na.rm = TRUE)]),
hum_pri_SF = ifelse(all(is.na(hum_pri_SF)), NA,
levels(hum_pri_SF)[max(as.integer(hum_pri_SF), na.rm = TRUE)]),
fox_pri_wet = ifelse(all(is.na(fox_pri_wet)), NA,
levels(fox_pri_wet)[max(as.integer(fox_pri_wet), na.rm = TRUE)]),
fox_pri_dry = ifelse(all(is.na(fox_pri_dry)), NA,
levels(fox_pri_dry)[max(as.integer(fox_pri_dry), na.rm = TRUE)]),
fox_pri_dune = ifelse(all(is.na(fox_pri_dune)), NA,
levels(fox_pri_dune)[max(as.integer(fox_pri_dune), na.rm = TRUE)]),
fox_pri_SF = ifelse(all(is.na(fox_pri_SF)), NA,
levels(fox_pri_SF)[max(as.integer(fox_pri_SF), na.rm = TRUE)]),
dog_pri_wet = ifelse(all(is.na(dog_pri_wet)), NA,
levels(dog_pri_wet)[max(as.integer(dog_pri_wet), na.rm = TRUE)]),
dog_pri_dry = ifelse(all(is.na(dog_pri_dry)), NA,
levels(dog_pri_dry)[max(as.integer(dog_pri_dry), na.rm = TRUE)]),
dog_pri_dune = ifelse(all(is.na(dog_pri_dune)), NA,
levels(dog_pri_dune)[max(as.integer(dog_pri_dune), na.rm = TRUE)]),
dog_pri_SF = ifelse(all(is.na(dog_pri_SF)), NA,
levels(dog_pri_SF)[max(as.integer(dog_pri_SF), na.rm = TRUE)]),
vehicle_pri_wet = ifelse(all(is.na(vehicle_pri_wet)), NA,
levels(vehicle_pri_wet)[max(as.integer(vehicle_pri_wet), na.rm = TRUE)]),
vehicle_pri_dry = ifelse(all(is.na(vehicle_pri_dry)), NA,
levels(vehicle_pri_dry)[max(as.integer(vehicle_pri_dry), na.rm = TRUE)]),
vehicle_pri_dune = ifelse(all(is.na(vehicle_pri_dune)), NA,
levels(vehicle_pri_dune)[max(as.integer(vehicle_pri_dune), na.rm = TRUE)]),
vehicle_pri_SF = ifelse(all(is.na(vehicle_pri_SF)), NA,
levels(vehicle_pri_SF)[max(as.integer(vehicle_pri_SF), na.rm = TRUE)]),
trailbike_pri_wet = ifelse(all(is.na(trailbike_pri_wet)), NA,
levels(trailbike_pri_wet)[max(as.integer(trailbike_pri_wet), na.rm = TRUE)]),
trailbike_pri_dry = ifelse(all(is.na(trailbike_pri_dry)), NA,
levels(trailbike_pri_dry)[max(as.integer(trailbike_pri_dry), na.rm = TRUE)]),
trailbike_pri_dune = ifelse(all(is.na(trailbike_pri_dune)), NA,
levels(trailbike_pri_dune)[max(as.integer(trailbike_pri_dune), na.rm = TRUE)]),
trailbike_pri_SF = ifelse(all(is.na(trailbike_pri_SF)), NA,
levels(trailbike_pri_SF)[max(as.integer(trailbike_pri_SF), na.rm = TRUE)]),
horse_pri_wet = ifelse(all(is.na(horse_pri_wet)), NA,
levels(horse_pri_wet)[max(as.integer(horse_pri_wet), na.rm = TRUE)]),
horse_pri_dry = ifelse(all(is.na(horse_pri_dry)), NA,
levels(horse_pri_dry)[max(as.integer(horse_pri_dry), na.rm = TRUE)]),
horse_pri_dune = ifelse(all(is.na(horse_pri_dune)), NA,
levels(horse_pri_dune)[max(as.integer(horse_pri_dune), na.rm = TRUE)]),
horse_pri_SF = ifelse(all(is.na(horse_pri_SF)), NA,
levels(horse_pri_SF)[max(as.integer(horse_pri_SF), na.rm = TRUE)]),
stock_pri_wet = ifelse(all(is.na(stock_pri_wet)), NA,
levels(stock_pri_wet)[max(as.integer(stock_pri_wet), na.rm = TRUE)]),
stock_pri_dry = ifelse(all(is.na(stock_pri_dry)), NA,
levels(stock_pri_dry)[max(as.integer(stock_pri_dry), na.rm = TRUE)]),
stock_pri_dune = ifelse(all(is.na(stock_pri_dune)), NA,
levels(stock_pri_dune)[max(as.integer(stock_pri_dune), na.rm = TRUE)]),
stock_pri_SF = ifelse(all(is.na(stock_pri_SF)), NA,
levels(stock_pri_SF)[max(as.integer(stock_pri_SF), na.rm = TRUE)])) %>%
# make the print variables a factor
mutate_at(vars(hum_pri_wet, hum_pri_dry, hum_pri_dune, hum_pri_SF,
dog_pri_wet, dog_pri_dry, dog_pri_dune, dog_pri_SF,
fox_pri_wet, fox_pri_dry, fox_pri_dune, fox_pri_SF,
vehicle_pri_wet, vehicle_pri_dry, vehicle_pri_dune, vehicle_pri_SF,
trailbike_pri_wet, trailbike_pri_dry, trailbike_pri_dune, trailbike_pri_SF,
horse_pri_wet, horse_pri_dry, horse_pri_dune, horse_pri_SF,
stock_pri_wet, stock_pri_dry, stock_pri_dune, stock_pri_SF),
~ as.factor(.)) %>%
# specify the level order of the print variables
mutate_at(vars(hum_pri_wet, hum_pri_dry, hum_pri_dune, hum_pri_SF,
dog_pri_wet, dog_pri_dry, dog_pri_dune, dog_pri_SF,
fox_pri_wet, fox_pri_dry, fox_pri_dune, fox_pri_SF,
vehicle_pri_wet, vehicle_pri_dry, vehicle_pri_dune, vehicle_pri_SF,
trailbike_pri_wet, trailbike_pri_dry, trailbike_pri_dune, trailbike_pri_SF,
horse_pri_wet, horse_pri_dry, horse_pri_dune, horse_pri_SF,
stock_pri_wet, stock_pri_dry, stock_pri_dune, stock_pri_SF),
~ factor(., levels = c("L", "M", "H"))) %>%
# summarize the print variables across the wet, dry, dune, and sign/fence micro habitats
mutate(hum_pri = ifelse(all(is.na(hum_pri_wet)) && all(is.na(hum_pri_dry)) &&
all(is.na(hum_pri_dune)) && all(is.na(hum_pri_SF)), NA,
pmax(as.integer(hum_pri_wet), as.integer(hum_pri_dry),
as.integer(hum_pri_dune), as.integer(hum_pri_SF), na.rm = TRUE)),
fox_pri = ifelse(all(is.na(fox_pri_wet)) && all(is.na(fox_pri_dry)) &&
all(is.na(fox_pri_dune)) && all(is.na(fox_pri_SF)), NA,
pmax(as.integer(fox_pri_wet), as.integer(fox_pri_dry),
as.integer(fox_pri_dune), as.integer(fox_pri_SF), na.rm = TRUE)),
dog_pri = ifelse(all(is.na(dog_pri_wet)) && all(is.na(dog_pri_dry)) &&
all(is.na(dog_pri_dune)) && all(is.na(dog_pri_SF)), NA,
pmax(as.integer(dog_pri_wet), as.integer(dog_pri_dry),
as.integer(dog_pri_dune), as.integer(dog_pri_SF), na.rm = TRUE)),
vehicle_pri = ifelse(all(is.na(vehicle_pri_wet)) && all(is.na(vehicle_pri_dry)) &&
all(is.na(vehicle_pri_dune)) && all(is.na(vehicle_pri_SF)) &&
all(is.na(trailbike_pri_wet)) && all(is.na(trailbike_pri_dry)) &&
all(is.na(trailbike_pri_dune)) && all(is.na(trailbike_pri_SF)), NA,
pmax(as.integer(vehicle_pri_wet), as.integer(vehicle_pri_dry),
as.integer(vehicle_pri_dune), as.integer(vehicle_pri_SF),
as.integer(trailbike_pri_wet), as.integer(trailbike_pri_dry),
as.integer(trailbike_pri_dune), as.integer(trailbike_pri_SF), na.rm = TRUE)),
hoofed_pri = ifelse(all(is.na(horse_pri_wet)) && all(is.na(horse_pri_dry)) &&
all(is.na(horse_pri_dune)) && all(is.na(horse_pri_SF)) &&
all(is.na(stock_pri_wet)) && all(is.na(stock_pri_dry)) &&
all(is.na(stock_pri_dune)) && all(is.na(stock_pri_SF)), NA,
pmax(as.integer(horse_pri_wet), as.integer(horse_pri_dry),
as.integer(horse_pri_dune), as.integer(horse_pri_SF),
as.integer(stock_pri_wet), as.integer(stock_pri_dry),
as.integer(stock_pri_dune), as.integer(stock_pri_SF), na.rm = TRUE))) %>%
# consolidate the threat data into a clean dataframe
dplyr::select(region, site, season, obs_date, obs_date2, obs_lon, obs_lat,
humans, vehicles, dogs, dogs_on, dogs_off, hoofed_animals, pred_birds,
hum_pri, fox_pri, dog_pri, vehicle_pri, hoofed_pri) %>%
ungroup()Visual inspection of threat data
Code
# determine the 99% quantile limit for each threat (i.e., to remove outlier data)
threat_data_99_ql <-
threat_data_ %>%
summarise_at(c("humans", "vehicles", "dogs", "dogs_on", "dogs_off", "hoofed_animals", "pred_birds"),
~ quantile(.x, probs = c(0.99)))
# check histograms of threat data while inspecting the 99% cut-off
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(humans + 1))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$humans[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(dogs + 1))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$dogs[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(pred_birds + 1))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$pred_birds[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(vehicles))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$vehicles[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(dogs_off + 1))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$dogs_off[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(log(dogs_on + 1))) +
geom_vline(xintercept = log(as.numeric(threat_data_99_ql$dogs_on[1])), color = "red") +
luke_theme
Code
threat_data_ %>%
ggplot() +
geom_histogram(aes(hoofed_animals)) +
geom_vline(xintercept = as.numeric(threat_data_99_ql$hoofed_animals[1]), color = "red") +
luke_theme
Extract holidays (an index of human disturbance)
Code
# extract public holidays and merge them to the threat data
#### FP ----
FP_holidays <-
bind_rows(
holiday_aus(2009, state = "SA"),
holiday_aus(2010, state = "SA"),
holiday_aus(2011, state = "SA"),
holiday_aus(2012, state = "SA"),
holiday_aus(2013, state = "SA"),
holiday_aus(2014, state = "SA"),
holiday_aus(2015, state = "SA"),
holiday_aus(2016, state = "SA"),
holiday_aus(2017, state = "SA"),
holiday_aus(2018, state = "SA"),
holiday_aus(2019, state = "SA"),
holiday_aus(2020, state = "SA"),
holiday_aus(2021, state = "SA")) %>%
mutate(event = holiday) %>%
mutate(region = "FP",
end_date = date) %>%
rename(start_date = date) %>%
mutate(year = year(start_date)) %>%
mutate(season = ifelse(month(start_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(start_date) >= 6,
paste0(year, substr(year + 1, 3, 4)),
paste0(season, substr(year, 3, 4))))
SA_start_end_holidays <-
read_excel("data/final/final_final/School holiday dates.xlsx",
sheet = "SA Sch. Hol Dates",
col_types = "text") %>%
separate(`Autumn school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(autumn_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
autumn_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Winter school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(winter_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
winter_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Spring school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(spring_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
spring_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Summer school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(summer_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
summer_end = as.Date(paste(as.character(as.numeric(Year)+1), new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(Year:Source))
FP_start_school_holidays <-
SA_start_end_holidays %>%
select(autumn_start, winter_start, spring_start, summer_start) %>%
pivot_longer(cols = everything(), names_to = "event") %>%
mutate(event = str_remove(event, "_start")) %>%
mutate(region = "FP") %>%
rename(start_date = value) %>%
mutate(year = year(start_date)) %>%
mutate(season = ifelse(month(start_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(start_date) >= 6,
paste0(year, substr(year+1, 3, 4)),
paste0(season, substr(year, 3, 4))))
FP_school_holidays <-
SA_start_end_holidays %>%
select(autumn_end, winter_end, spring_end, summer_end) %>%
pivot_longer(cols = everything(), names_to = "event") %>%
mutate(event = str_remove(event, "_end")) %>%
rename(end_date = value) %>%
mutate(year = year(end_date)) %>%
mutate(season = ifelse(month(end_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(end_date) >= 6,
paste0(year, substr(year+1, 3, 4)),
paste0(season, substr(year, 3, 4)))) %>%
left_join(FP_start_school_holidays, ., by = c("season", "event")) %>%
mutate(event = paste(event, "school", sep = "_")) %>%
select(-c(year.x, year.y))
FP_holidays <-
bind_rows(FP_school_holidays, FP_holidays) %>%
select(season, region, event, start_date, end_date) %>%
arrange(start_date)
#### MP ----
MP_holidays <-
bind_rows(
holiday_aus(2006, state = "VIC"),
holiday_aus(2007, state = "VIC"),
holiday_aus(2008, state = "VIC"),
holiday_aus(2009, state = "VIC"),
holiday_aus(2010, state = "VIC"),
holiday_aus(2011, state = "VIC"),
holiday_aus(2012, state = "VIC"),
holiday_aus(2013, state = "VIC"),
holiday_aus(2014, state = "VIC"),
holiday_aus(2015, state = "VIC"),
holiday_aus(2016, state = "VIC"),
holiday_aus(2017, state = "VIC"),
holiday_aus(2018, state = "VIC"),
holiday_aus(2019, state = "VIC"),
holiday_aus(2020, state = "VIC"),
holiday_aus(2021, state = "VIC")) %>%
mutate(event = holiday) %>%
mutate(region = "MP",
end_date = date) %>%
rename(start_date = date) %>%
mutate(year = year(start_date)) %>%
mutate(season = ifelse(month(start_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(start_date) >= 6,
paste0(year, substr(year + 1, 3, 4)),
paste0(season, substr(year, 3, 4))))
VIC_start_end_holidays <-
read_excel("data/final/final_final/School holiday dates.xlsx",
sheet = "VIC Sch. Hol. Dates",
col_types = "text") %>%
separate(`Autumn school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(autumn_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
autumn_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Winter school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(winter_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
winter_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Spring school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(spring_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
spring_end = as.Date(paste(Year, new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(new_col1:new_col5)) %>%
separate(`Summer school holiday dates`,
into = paste0("new_col", 1:5), sep = " ") %>%
mutate(summer_start = as.Date(paste(Year, new_col2, new_col1, sep = "-"),
format = "%Y-%b-%d"),
summer_end = as.Date(paste(as.character(as.numeric(Year)+1), new_col5, new_col4, sep = "-"),
format = "%Y-%b-%d")) %>%
dplyr::select(-c(Year:Source))
MP_start_school_holidays <-
VIC_start_end_holidays %>%
select(autumn_start, winter_start, spring_start, summer_start) %>%
pivot_longer(cols = everything(), names_to = "event") %>%
mutate(event = str_remove(event, "_start")) %>%
mutate(region = "FP") %>%
rename(start_date = value) %>%
mutate(year = year(start_date)) %>%
mutate(season = ifelse(month(start_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(start_date) >= 6,
paste0(year, substr(year+1, 3, 4)),
paste0(season, substr(year, 3, 4))))
MP_school_holidays <-
VIC_start_end_holidays %>%
select(autumn_end, winter_end, spring_end, summer_end) %>%
pivot_longer(cols = everything(), names_to = "event") %>%
mutate(event = str_remove(event, "_end")) %>%
rename(end_date = value) %>%
mutate(year = year(end_date)) %>%
mutate(season = ifelse(month(end_date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(end_date) >= 6,
paste0(year, substr(year+1, 3, 4)),
paste0(season, substr(year, 3, 4)))) %>%
left_join(MP_start_school_holidays, ., by = c("season", "event")) %>%
mutate(event = paste(event, "school", sep = "_")) %>%
select(-c(year.x, year.y)) %>% arrange(start_date)
MP_holidays <-
bind_rows(MP_school_holidays, MP_holidays) %>%
select(season, region, event, start_date, end_date) %>%
arrange(start_date)
BSC_holidays <-
bind_rows(MP_school_holidays, MP_holidays) %>%
select(season, region, event, start_date, end_date) %>%
arrange(start_date) %>%
mutate(region = "BSC")
holidays <-
bind_rows(FP_holidays, BSC_holidays, MP_holidays)# %>%
# pivot_longer(-c(season:holiday), names_to = "start_end", values_to = "date")Extract Weekdays (another index of human disturbance)
Code
threat_data__ <-
threat_data_ %>%
mutate(season_site = paste(season, site, sep = "_"),
weekday = factor(as.factor(weekdays(obs_date)),
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday",
"Sunday"))) %>%
rename(date = obs_date) %>%
left_join(., holidays, by = c("region", "season"), relationship = "many-to-many") %>%
mutate(holiday = ifelse(date >= start_date & date <= end_date, 1, 0)) %>%
# dplyr::select(region, season, site, date, start_date, end_date, event, holiday) %>% distinct() %>%
group_by(region, season, site, date) %>%
mutate(holiday = max(holiday, na.rm = TRUE)) %>%
dplyr::select(-c(event, start_date, end_date)) %>%
distinct() %>%
ungroup() %>%
mutate(day_type = ifelse(holiday == 1 | weekday %in%
c("Saturday", "Sunday"), "funday", "workday")) %>%
mutate(funday = ifelse(day_type == "funday", 1, 0)) %>%
mutate(humans_ = ifelse(humans > 65, NA, humans),
vehicles_ = ifelse(vehicles > 6, NA, vehicles),
dogs_ = ifelse(dogs > 14, NA, dogs),
dogs_off_ = ifelse(dogs_off > 10, NA, dogs_off),
dogs_on_ = ifelse(dogs_on > 7, NA, dogs_on),
hoofed_animals_ = ifelse(hoofed_animals > 2, NA, hoofed_animals),
pred_birds_ = ifelse(pred_birds > 200, NA, pred_birds)) %>%
mutate(weekdayN = as.numeric(weekday) - 1) %>%
mutate(weekdayC = circular::circular(weekdayN, type = "angles", units = "radians")) %>%
filter(!is.na(weekday))
threat_data__ %>%
ggplot() +
geom_histogram(aes(funday)) +
# geom_vline(xintercept = log(10), color = "red") +
luke_theme
Code
#### test if weekends and holidays have more threat counts than other days
# use a zero-inflated model (https://stats.oarc.ucla.edu/r/dae/zip/)
# for all threats, there are more counted on weekends and holidays than during the week,
# except for vehicles (which occur randomly across the week)
mod_hum_zi <- pscl::zeroinfl(humans_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_hum_zi)
Call:
pscl::zeroinfl(formula = humans_ ~ day_type, data = threat_data__, dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-1.1167 -0.7764 -0.7764 0.1435 19.1555
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.283190 0.003276 696.8 <2e-16 ***
day_typeworkday -0.537083 0.005252 -102.3 <2e-16 ***
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.45390 0.01646 -27.57 <2e-16 ***
day_typeworkday 0.68819 0.02102 32.74 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 6
Log-likelihood: -1.349e+05 on 4 DfCode
mod_dogs_zi <- pscl::zeroinfl(dogs_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_dogs_zi)
Call:
pscl::zeroinfl(formula = dogs_ ~ day_type, data = threat_data__, dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-0.6585 -0.4541 -0.4541 -0.1849 9.6045
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 1.279992 0.007178 178.33 <2e-16 ***
day_typeworkday -0.287836 0.011567 -24.89 <2e-16 ***
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.46178 0.01689 27.34 <2e-16 ***
day_typeworkday 0.72214 0.02337 30.91 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 7
Log-likelihood: -4.849e+04 on 4 DfCode
mod_dogs_on_zi <- pscl::zeroinfl(dogs_on_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_dogs_on_zi)
Call:
pscl::zeroinfl(formula = dogs_on_ ~ day_type, data = threat_data__, dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-0.4619 -0.4619 -0.3005 -0.3005 10.4039
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.62654 0.01390 45.08 <2e-16 ***
day_typeworkday -0.30974 0.02433 -12.73 <2e-16 ***
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.99540 0.02121 46.93 <2e-16 ***
day_typeworkday 0.79401 0.03231 24.57 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 9
Log-likelihood: -2.531e+04 on 4 DfCode
mod_dogs_off_zi <- pscl::zeroinfl(dogs_off_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_dogs_off_zi)
Call:
pscl::zeroinfl(formula = dogs_off_ ~ day_type, data = threat_data__,
dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-0.5282 -0.5282 -0.3830 -0.3830 8.6505
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 1.02943 0.00973 105.81 <2e-16 ***
day_typeworkday -0.19020 0.01507 -12.62 <2e-16 ***
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.86628 0.01852 46.79 <2e-16 ***
day_typeworkday 0.62880 0.02594 24.24 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 7
Log-likelihood: -3.604e+04 on 4 DfCode
mod_pred_birds_zi <- pscl::zeroinfl(pred_birds_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_pred_birds_zi)
Call:
pscl::zeroinfl(formula = pred_birds_ ~ day_type, data = threat_data__,
dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-0.9465 -0.8264 -0.8264 -0.2222 29.3842
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.801337 0.002780 1007.55 <2e-16 ***
day_typeworkday -0.277058 0.003926 -70.58 <2e-16 ***
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.004979 0.015976 -0.312 0.755
day_typeworkday 0.253056 0.020637 12.262 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 1
Log-likelihood: -2.816e+05 on 4 DfCode
mod_vehicles_zi <- pscl::zeroinfl(vehicles_ ~ day_type, data = threat_data__, dist = "poisson")
summary(mod_vehicles_zi)
Call:
pscl::zeroinfl(formula = vehicles_ ~ day_type, data = threat_data__,
dist = "poisson")
Pearson residuals:
Min 1Q Median 3Q Max
-0.1515 -0.1515 -0.1141 -0.1141 16.7320
Count model coefficients (poisson with log link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.766281 0.035562 21.547 <2e-16 ***
day_typeworkday 0.004824 0.051951 0.093 0.926
Zero-inflation model coefficients (binomial with logit link):
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.38138 0.04899 69.022 < 2e-16 ***
day_typeworkday 0.57379 0.07135 8.042 8.83e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Number of iterations in BFGS optimization: 9
Log-likelihood: -5486 on 4 DfCode
#### Fit circular GAM to weekly count data ----
mod_hum <-
mgcv::gam(humans_ ~ s(weekdayN, bs = "cc", k = 7), data = threat_data__)
summary(mod_hum)
Family: gaussian
Link function: identity
Formula:
humans_ ~ s(weekdayN, bs = "cc", k = 7)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.89799 0.03891 100.2 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
s(weekdayN) 4.906 5 95.09 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.0119 Deviance explained = 1.2%
GCV = 59.684 Scale est. = 59.675 n = 39426Code
mod_dogs <-
mgcv::gam(dogs_ ~ s(weekdayN, bs = "cc", k = 7), data = threat_data__)
summary(mod_dogs)
Family: gaussian
Link function: identity
Formula:
dogs_ ~ s(weekdayN, bs = "cc", k = 7)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.93086 0.01054 88.28 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
s(weekdayN) 4.567 5 32.36 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.00407 Deviance explained = 0.418%
GCV = 4.3841 Scale est. = 4.3835 n = 39425Code
mod_pred_birds <-
mgcv::gam(pred_birds_ ~ s(weekdayN, bs = "cc", k = 7), data = threat_data__)
summary(mod_pred_birds)
Family: gaussian
Link function: identity
Formula:
pred_birds_ ~ s(weekdayN, bs = "cc", k = 7)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.57583 0.09625 68.32 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
s(weekdayN) 4.215 5 4.275 0.000163 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.000482 Deviance explained = 0.0589%
GCV = 365.72 Scale est. = 365.67 n = 39472Code
mod_vehicles <-
mgcv::gam(vehicles_ ~ s(weekdayN, bs = "cc", k = 7), data = threat_data__)
summary(mod_vehicles)
Family: gaussian
Link function: identity
Formula:
vehicles_ ~ s(weekdayN, bs = "cc", k = 7)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.052537 0.002113 24.86 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
s(weekdayN) 1.445 5 0.992 0.0213 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.000135 Deviance explained = 0.0171%
GCV = 0.17618 Scale est. = 0.17617 n = 39458Code
# estimate model predictions
newdata_weekdays <-
data.frame(weekdayN = seq(0, 6))
mod_hum_fits <-
predict(mod_hum,
newdata = newdata_weekdays,
type = 'response', se = TRUE)
mod_hum_predicts <-
data.frame(newdata_weekdays, mod_hum_fits) %>%
mutate(lower = fit - 1.96 * se.fit,
upper = fit + 1.96 * se.fit) %>%
left_join(., threat_data__ %>% dplyr::select(weekdayN, weekday) %>% distinct(), by = "weekdayN")
# plot the weekly variation in the human counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = humans_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = humans_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = humans_),
method = lm,
formula = y ~ splines::bs(x, 5)) +
# geom_ribbon(data = mod_hum_predicts,
# aes(x = as.numeric(weekday), ymin = lower, ymax = upper)) +
# geom_line(data = mod_hum_predicts, aes(x = as.numeric(weekday), y = fit), color = "white") +
luke_theme +
xlab("day of the week") +
ylab("number of humans counted")
Code
# plot the weekly variation in the dog counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = dogs_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = dogs_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = dogs_), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("number of dogs counted")
Code
# plot the weekly variation in the dog on leash counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = dogs_on_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = dogs_on_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = dogs_on_), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("number of dogs on leashes counted")
Code
# plot the weekly variation in the dog off leash counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = dogs_off_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = dogs_off_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = dogs_off_), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("number of dogs off leashes counted")
Code
# plot the weekly variation in the predatory bird counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = pred_birds_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = pred_birds_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = pred_birds_), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("number of predatory birds counted")
Code
# plot the weekly variation in the vehicle counts
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = vehicles_),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = vehicles_),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = vehicles_), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("number of vehicles counted")
Code
# plot the weekly variation in the human print detections
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = hum_pri),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = hum_pri),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = hum_pri), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("level of human prints recorded")
Code
# plot the weekly variation in the dog print detections
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = dog_pri),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = dog_pri),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = dog_pri), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("level of dogs prints recorded")
Code
# plot the weekly variation in the vehicle print detections
threat_data__ %>%
ggplot() +
gghalves::geom_half_point(aes(x = weekday, y = vehicle_pri),
size = 1,
width = 0.5,
side = "l",
range_scale = .4,
alpha = 0.1
) +
gghalves::geom_half_boxplot(aes(x = weekday, y = vehicle_pri),
size = 0.5,
width = 0.5,
side = "r",
alpha = 0.1, outlier.color = NA
) +
geom_smooth(aes(x = as.numeric(weekday), y = vehicle_pri), method = lm, formula = y ~ splines::bs(x, 5)) +
luke_theme +
xlab("day of the week") +
ylab("level of vehicle prints recorded")
Code
# check correlation between humans counts
threat_data__ %>%
dplyr::select(humans_, vehicles_, dogs_, pred_birds_) %>%
na.omit() %>%
cor() %>%
corrplot(type = "upper", method = "number", tl.srt = 45)
Code
# relationship between human counts and dog counts
threat_data__ %>%
ggplot() +
geom_jitter(aes(x = humans_, y = dogs_), alpha = 0.1) +
geom_smooth(aes(x = humans_, y = dogs_)) +#, method = lm, formula = y ~ splines::bs(x, 2)) +
luke_theme +
xlab("Number of humans counted") +
ylab("Number of dogs counted")
Code
# relationship between human counts and predatory bird counts
threat_data__ %>%
ggplot() +
geom_jitter(aes(x = humans_, y = pred_birds_), alpha = 0.1) +
geom_smooth(aes(x = humans_, y = pred_birds_)) +#, method = lm) +
luke_theme +
xlab("Number of humans counted") +
ylab("Number of predatory birds counted")
Code
# relationship between human counts and vehicle counts
threat_data__ %>%
ggplot() +
geom_jitter(aes(x = humans_, y = vehicles_), alpha = 0.1) +
geom_smooth(aes(x = humans_, y = vehicles_)) + #, method = lm, formula = y ~ splines::bs(x, 2)) +
luke_theme +
xlab("Number of humans counted") +
ylab("Number of vehicles counted")
Code
# determine which territories are in the threat data and the nest data
sites_intersect_FP <-
inner_join(nest_data_FP, threat_data__ %>% filter(region == "FP"), by = c("season", "site"), relationship = "many-to-many") %>%
dplyr::select(season, site) %>% distinct() %>%
mutate(season_site = paste(season, site, sep = "_"))
sites_intersect_MP <-
inner_join(nest_data_MP, threat_data__ %>% filter(region == "MP"), by = c("season", "site"), relationship = "many-to-many") %>%
dplyr::select(season, site) %>% distinct() %>%
mutate(season_site = paste(season, site, sep = "_"))
sites_intersect_BSC <-
inner_join(nest_data_BSC, threat_data__ %>% filter(region == "BSC"), by = c("season", "site"), relationship = "many-to-many") %>%
dplyr::select(season, site) %>% distinct() %>%
mutate(season_site = paste(season, site, sep = "_"))Fleurieu Peninsula: summarise threat data
Code
nest_data_FP_with_threat_data <-
nest_data_FP %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_FP$season_site) %>%
dplyr::select(season, site, region, nest_ID,
FirstFound, LastPresent, LastChecked,
first_found2, last_alive2, last_checked2,
management_status, management_level,
nest_hab, Fate) %>%
rename(status = management_status,
level = management_level) %>%
mutate(level = paste0("L", level)) %>%
mutate(level = factor(level,
levels = c("L0", "L1",
"L2", "L3",
"L4"))) %>%
ungroup() %>%
mutate(
hum_a = NA,
veh_a = NA,
dog_a = NA,
don_a = NA,
dof_a = NA,
hof_a = NA,
pbd_a = NA,
hum_m = NA,
veh_m = NA,
dog_m = NA,
don_m = NA,
dof_m = NA,
hof_m = NA,
pbd_m = NA,
hum_b = NA,
veh_b = NA,
dog_b = NA,
don_b = NA,
dof_b = NA,
pbd_b = NA,
hof_b = NA,
hum_p = NA,
veh_p = NA,
dog_p = NA,
hof_p = NA,
fox_p = NA,
n_surveys = NA,
days_active = NA,
fundays = NA,
uncertain_days = NA,
halfway = NA) %>%
filter(FirstFound <= LastPresent & FirstFound <= LastChecked & LastPresent <= LastChecked) %>%
filter(first_found2 <= last_alive2 & first_found2 <= last_checked2 & last_alive2 <= last_checked2)
FP_threat_data_subset <-
threat_data__ %>%
filter(region == "FP") %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_FP$season_site) %>%
ungroup()
for(i in 1:nrow(nest_data_FP_with_threat_data)){
FirstFound <- nest_data_FP_with_threat_data$FirstFound[i]
LastPresent <- nest_data_FP_with_threat_data$LastPresent[i]
LastChecked <- nest_data_FP_with_threat_data$LastChecked[i]
FirstFound2 <- nest_data_FP_with_threat_data$first_found2[i]
LastPresent2 <- nest_data_FP_with_threat_data$last_alive2[i]
LastChecked2 <- nest_data_FP_with_threat_data$last_checked2[i]
halfway <- (LastChecked - LastPresent)/2
days_active <- (LastPresent + halfway) - FirstFound
uncertain_days <- LastChecked - LastPresent
site_ <- as.character(nest_data_FP_with_threat_data$site[i])
season_ <- as.character(nest_data_FP_with_threat_data$season[i])
fundays_df <-
data.frame(date = seq(from = LastPresent2, to = LastChecked2, 1)) %>%
# mutate(weekday = weekdays(dates)) %>%
mutate(weekday = factor(as.factor(weekdays(date)),
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday",
"Sunday")),
region = "FP") %>%
mutate(year = year(date)) %>%
mutate(season = ifelse(month(date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(date) >= 6,
paste0(year, substr(year + 1, 3, 4)),
paste0(season, substr(year, 3, 4)))) %>%
left_join(., holidays, by = c("region", "season"), relationship = "many-to-many") %>%
mutate(holiday = ifelse(date >= start_date & date <= end_date, 1, 0)) %>%
group_by(region, season, date) %>%
mutate(holiday = max(holiday, na.rm = TRUE)) %>%
dplyr::select(-c(event, start_date, end_date)) %>%
distinct() %>%
ungroup() %>%
mutate(day_type = ifelse(holiday == 1 | weekday %in%
c("Saturday", "Sunday"), "funday", "workday")) %>%
mutate(funday = ifelse(day_type == "funday", 1, 0))
FP_threat_data_subset_ <-
FP_threat_data_subset %>%
ungroup() %>%
# data.frame() %>%
# dplyr::filter(as.numeric(obs_date2) >= FirstFound & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
# dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + (LastChecked - LastPresent)) & season == season_) %>%
dplyr::filter(site == site_)
if(nrow(FP_threat_data_subset_) > 0){
avgeraged_threats <-
FP_threat_data_subset_ %>%
mutate(hum_bi = ifelse(humans > 0 | (!is.na(hum_pri)), 1, 0),
vehicle_bi = ifelse(vehicles > 0 | (!is.na(vehicle_pri)), 1, 0),
dogs_bi = ifelse(dogs > 0 | (!is.na(dog_pri)), 1, 0),
dogs_off_bi = ifelse(dogs_off > 0, 1, 0),
dogs_on_bi = ifelse(dogs_on > 0, 1, 0),
p_birds_bi = ifelse(pred_birds > 0, 1, 0),
hoof_bi = ifelse(hoofed_animals > 0 | (!is.na(hoofed_pri)), 1, 0)) %>%
dplyr::summarise(
# fundays = sum(funday),
hum_avg = mean(humans, na.rm = TRUE),
vehicles_avg = mean(vehicles, na.rm = TRUE),
dogs_avg = mean(dogs, na.rm = TRUE),
dogs_on_avg = mean(dogs_on, na.rm = TRUE),
dogs_off_avg = mean(dogs_off, na.rm = TRUE),
hoof_avg = mean(hoofed_animals, na.rm = TRUE),
p_birds_avg = mean(pred_birds, na.rm = TRUE),
hum_max = max(humans, na.rm = TRUE),
vehicles_max = max(vehicles, na.rm = TRUE),
dogs_max = max(dogs, na.rm = TRUE),
dogs_on_max = max(dogs_on, na.rm = TRUE),
dogs_off_max = max(dogs_off, na.rm = TRUE),
hoof_max = max(hoofed_animals, na.rm = TRUE),
p_birds_max = max(pred_birds, na.rm = TRUE),
hum_bi = max(hum_bi, na.rm = TRUE),
vehicle_bi = max(vehicle_bi, na.rm = TRUE),
dogs_bi = max(dogs_bi, na.rm = TRUE),
dogs_on_bi = max(dogs_on_bi, na.rm = TRUE),
dogs_off_bi = max(dogs_off_bi, na.rm = TRUE),
p_birds_bi = max(p_birds_bi, na.rm = TRUE),
hoof_bi = max(hoof_bi, na.rm = TRUE),
hum_pr = mean(hum_pri, na.rm = TRUE),
vehicle_pr = mean(vehicle_pri, na.rm = TRUE),
dog_pr = mean(dog_pri, na.rm = TRUE),
hoof_pr = mean(hoofed_pri, na.rm = TRUE),
fox_pr = mean(fox_pri, na.rm = TRUE),
n_surveys = n(),
days_active = days_active,
halfway = halfway,
uncertain_days = uncertain_days)
nest_data_FP_with_threat_data$fundays[i] <- sum(fundays_df$funday)
nest_data_FP_with_threat_data$hum_a[i] <- avgeraged_threats$hum_avg
nest_data_FP_with_threat_data$veh_a[i] <- avgeraged_threats$vehicles_avg
nest_data_FP_with_threat_data$dog_a[i] <- avgeraged_threats$dogs_avg
nest_data_FP_with_threat_data$don_a[i] <- avgeraged_threats$dogs_on_avg
nest_data_FP_with_threat_data$dof_a[i] <- avgeraged_threats$dogs_off_avg
nest_data_FP_with_threat_data$hof_a[i] <- avgeraged_threats$hoof_avg
nest_data_FP_with_threat_data$pbd_a[i] <- avgeraged_threats$p_birds_avg
nest_data_FP_with_threat_data$hum_m[i] <- avgeraged_threats$hum_max
nest_data_FP_with_threat_data$veh_m[i] <- avgeraged_threats$vehicles_max
nest_data_FP_with_threat_data$dog_m[i] <- avgeraged_threats$dogs_max
nest_data_FP_with_threat_data$don_m[i] <- avgeraged_threats$dogs_on_max
nest_data_FP_with_threat_data$dof_m[i] <- avgeraged_threats$dogs_off_max
nest_data_FP_with_threat_data$hof_m[i] <- avgeraged_threats$hoof_max
nest_data_FP_with_threat_data$pbd_m[i] <- avgeraged_threats$p_birds_max
nest_data_FP_with_threat_data$hum_b[i] <- avgeraged_threats$hum_bi
nest_data_FP_with_threat_data$veh_b[i] <- avgeraged_threats$vehicle_bi
nest_data_FP_with_threat_data$dog_b[i] <- avgeraged_threats$dogs_bi
nest_data_FP_with_threat_data$don_b[i] <- avgeraged_threats$dogs_on_bi
nest_data_FP_with_threat_data$dof_b[i] <- avgeraged_threats$dogs_off_bi
nest_data_FP_with_threat_data$pbd_b[i] <- avgeraged_threats$p_birds_bi
nest_data_FP_with_threat_data$hof_b[i] <- avgeraged_threats$hoof_bi
nest_data_FP_with_threat_data$hum_p[i] <- avgeraged_threats$hum_pr
nest_data_FP_with_threat_data$veh_p[i] <- avgeraged_threats$vehicle_pr
nest_data_FP_with_threat_data$dog_p[i] <- avgeraged_threats$dog_pr
nest_data_FP_with_threat_data$hof_p[i] <- avgeraged_threats$hoof_pr
nest_data_FP_with_threat_data$fox_p[i] <- avgeraged_threats$fox_pr
nest_data_FP_with_threat_data$n_surveys[i] <- avgeraged_threats$n_surveys
nest_data_FP_with_threat_data$days_active[i] <- avgeraged_threats$days_active
nest_data_FP_with_threat_data$halfway[i] <- avgeraged_threats$halfway
nest_data_FP_with_threat_data$uncertain_days[i] <- avgeraged_threats$uncertain_days
}else{
nest_data_FP_with_threat_data$hum_a[i] <- NA
nest_data_FP_with_threat_data$veh_a[i] <- NA
nest_data_FP_with_threat_data$dog_a[i] <- NA
nest_data_FP_with_threat_data$don_a[i] <- NA
nest_data_FP_with_threat_data$dof_a[i] <- NA
nest_data_FP_with_threat_data$hof_a[i] <- NA
nest_data_FP_with_threat_data$pbd_a[i] <- NA
nest_data_FP_with_threat_data$hum_m[i] <- NA
nest_data_FP_with_threat_data$veh_m[i] <- NA
nest_data_FP_with_threat_data$dog_m[i] <- NA
nest_data_FP_with_threat_data$don_m[i] <- NA
nest_data_FP_with_threat_data$dof_m[i] <- NA
nest_data_FP_with_threat_data$hof_m[i] <- NA
nest_data_FP_with_threat_data$pbd_m[i] <- NA
nest_data_FP_with_threat_data$hum_b[i] <- NA
nest_data_FP_with_threat_data$veh_b[i] <- NA
nest_data_FP_with_threat_data$dog_b[i] <- NA
nest_data_FP_with_threat_data$don_b[i] <- NA
nest_data_FP_with_threat_data$dof_b[i] <- NA
nest_data_FP_with_threat_data$pbd_b[i] <- NA
nest_data_FP_with_threat_data$hof_b[i] <- NA
nest_data_FP_with_threat_data$hum_p[i] <- NA
nest_data_FP_with_threat_data$veh_p[i] <- NA
nest_data_FP_with_threat_data$dog_p[i] <- NA
nest_data_FP_with_threat_data$hof_p[i] <- NA
nest_data_FP_with_threat_data$fox_p[i] <- NA
nest_data_FP_with_threat_data$n_surveys[i] <- 0
nest_data_FP_with_threat_data$days_active[i] <- days_active
nest_data_FP_with_threat_data$halfway[i] <- halfway
nest_data_FP_with_threat_data$uncertain_days[i] <- uncertain_days
nest_data_FP_with_threat_data$fundays[i] <- NA
}
}Mornington Peninsula: summarise threat data
Code
nest_data_MP_with_threat_data <-
nest_data_MP %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_MP$season_site) %>%
dplyr::select(season, site, region, nest_ID,
FirstFound, LastPresent, LastChecked,
first_found2, last_alive2, last_checked2,
management_status, management_level,
nest_hab, Fate) %>%
rename(status = management_status,
level = management_level) %>%
mutate(level = paste0("L", level)) %>%
mutate(level = factor(level,
levels = c("L0", "L1",
"L2", "L3",
"L4"))) %>%
ungroup() %>%
mutate(
hum_a = NA,
veh_a = NA,
dog_a = NA,
don_a = NA,
dof_a = NA,
hof_a = NA,
pbd_a = NA,
hum_m = NA,
veh_m = NA,
dog_m = NA,
don_m = NA,
dof_m = NA,
hof_m = NA,
pbd_m = NA,
hum_b = NA,
veh_b = NA,
dog_b = NA,
don_b = NA,
dof_b = NA,
pbd_b = NA,
hof_b = NA,
hum_p = NA,
veh_p = NA,
dog_p = NA,
hof_p = NA,
fox_p = NA,
n_surveys = NA,
days_active = NA,
fundays = NA,
uncertain_days = NA,
halfway = NA) %>%
filter(FirstFound <= LastPresent & FirstFound <= LastChecked & LastPresent <= LastChecked) %>%
filter(first_found2 <= last_alive2 & first_found2 <= last_checked2 & last_alive2 <= last_checked2)
MP_threat_data_subset <-
threat_data__ %>%
filter(region == "MP") %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_MP$season_site) %>%
ungroup()
for(i in 1:nrow(nest_data_MP_with_threat_data)){
FirstFound <- nest_data_MP_with_threat_data$FirstFound[i]
LastPresent <- nest_data_MP_with_threat_data$LastPresent[i]
LastChecked <- nest_data_MP_with_threat_data$LastChecked[i]
FirstFound2 <- nest_data_MP_with_threat_data$first_found2[i]
LastPresent2 <- nest_data_MP_with_threat_data$last_alive2[i]
LastChecked2 <- nest_data_MP_with_threat_data$last_checked2[i]
halfway <- (LastChecked - LastPresent)/2
days_active <- (LastPresent + halfway) - FirstFound
uncertain_days <- LastChecked - LastPresent
site_ <- as.character(nest_data_MP_with_threat_data$site[i])
season_ <- as.character(nest_data_MP_with_threat_data$season[i])
fundays_df <-
data.frame(date = seq(from = LastPresent2, to = LastChecked2, 1)) %>%
# mutate(weekday = weekdays(dates)) %>%
mutate(weekday = factor(as.factor(weekdays(date)),
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday",
"Sunday")),
region = "FP") %>%
mutate(year = year(date)) %>%
mutate(season = ifelse(month(date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(date) >= 6,
paste0(year, substr(year + 1, 3, 4)),
paste0(season, substr(year, 3, 4)))) %>%
left_join(., holidays, by = c("region", "season"), relationship = "many-to-many") %>%
mutate(holiday = ifelse(date >= start_date & date <= end_date, 1, 0)) %>%
group_by(region, season, date) %>%
mutate(holiday = max(holiday, na.rm = TRUE)) %>%
dplyr::select(-c(event, start_date, end_date)) %>%
distinct() %>%
ungroup() %>%
mutate(day_type = ifelse(holiday == 1 | weekday %in%
c("Saturday", "Sunday"), "funday", "workday")) %>%
mutate(funday = ifelse(day_type == "funday", 1, 0))
MP_threat_data_subset_ <-
MP_threat_data_subset %>%
ungroup() %>%
# data.frame() %>%
# dplyr::filter(as.numeric(obs_date2) >= FirstFound & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
# dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + (LastChecked - LastPresent)) & season == season_) %>%
dplyr::filter(site == site_)
if(nrow(MP_threat_data_subset_) > 0){
avgeraged_threats <-
MP_threat_data_subset_ %>%
mutate(hum_bi = ifelse(humans > 0 | (!is.na(hum_pri)), 1, 0),
vehicle_bi = ifelse(vehicles > 0 | (!is.na(vehicle_pri)), 1, 0),
dogs_bi = ifelse(dogs > 0 | (!is.na(dog_pri)), 1, 0),
dogs_off_bi = ifelse(dogs_off > 0, 1, 0),
dogs_on_bi = ifelse(dogs_on > 0, 1, 0),
p_birds_bi = ifelse(pred_birds > 0, 1, 0),
hoof_bi = ifelse(hoofed_animals > 0 | (!is.na(hoofed_pri)), 1, 0)) %>%
dplyr::summarise(
# fundays = sum(funday),
hum_avg = mean(humans, na.rm = TRUE),
vehicles_avg = mean(vehicles, na.rm = TRUE),
dogs_avg = mean(dogs, na.rm = TRUE),
dogs_on_avg = mean(dogs_on, na.rm = TRUE),
dogs_off_avg = mean(dogs_off, na.rm = TRUE),
hoof_avg = mean(hoofed_animals, na.rm = TRUE),
p_birds_avg = mean(pred_birds, na.rm = TRUE),
hum_max = max(humans, na.rm = TRUE),
vehicles_max = max(vehicles, na.rm = TRUE),
dogs_max = max(dogs, na.rm = TRUE),
dogs_on_max = max(dogs_on, na.rm = TRUE),
dogs_off_max = max(dogs_off, na.rm = TRUE),
hoof_max = max(hoofed_animals, na.rm = TRUE),
p_birds_max = max(pred_birds, na.rm = TRUE),
hum_bi = max(hum_bi, na.rm = TRUE),
vehicle_bi = max(vehicle_bi, na.rm = TRUE),
dogs_bi = max(dogs_bi, na.rm = TRUE),
dogs_on_bi = max(dogs_on_bi, na.rm = TRUE),
dogs_off_bi = max(dogs_off_bi, na.rm = TRUE),
p_birds_bi = max(p_birds_bi, na.rm = TRUE),
hoof_bi = max(hoof_bi, na.rm = TRUE),
hum_pr = mean(hum_pri, na.rm = TRUE),
vehicle_pr = mean(vehicle_pri, na.rm = TRUE),
dog_pr = mean(dog_pri, na.rm = TRUE),
hoof_pr = mean(hoofed_pri, na.rm = TRUE),
fox_pr = mean(fox_pri, na.rm = TRUE),
n_surveys = n(),
days_active = days_active,
halfway = halfway,
uncertain_days = uncertain_days)
nest_data_MP_with_threat_data$fundays[i] <- sum(fundays_df$funday)
nest_data_MP_with_threat_data$hum_a[i] <- avgeraged_threats$hum_avg
nest_data_MP_with_threat_data$veh_a[i] <- avgeraged_threats$vehicles_avg
nest_data_MP_with_threat_data$dog_a[i] <- avgeraged_threats$dogs_avg
nest_data_MP_with_threat_data$don_a[i] <- avgeraged_threats$dogs_on_avg
nest_data_MP_with_threat_data$dof_a[i] <- avgeraged_threats$dogs_off_avg
nest_data_MP_with_threat_data$hof_a[i] <- avgeraged_threats$hoof_avg
nest_data_MP_with_threat_data$pbd_a[i] <- avgeraged_threats$p_birds_avg
nest_data_MP_with_threat_data$hum_m[i] <- avgeraged_threats$hum_max
nest_data_MP_with_threat_data$veh_m[i] <- avgeraged_threats$vehicles_max
nest_data_MP_with_threat_data$dog_m[i] <- avgeraged_threats$dogs_max
nest_data_MP_with_threat_data$don_m[i] <- avgeraged_threats$dogs_on_max
nest_data_MP_with_threat_data$dof_m[i] <- avgeraged_threats$dogs_off_max
nest_data_MP_with_threat_data$hof_m[i] <- avgeraged_threats$hoof_max
nest_data_MP_with_threat_data$pbd_m[i] <- avgeraged_threats$p_birds_max
nest_data_MP_with_threat_data$hum_b[i] <- avgeraged_threats$hum_bi
nest_data_MP_with_threat_data$veh_b[i] <- avgeraged_threats$vehicle_bi
nest_data_MP_with_threat_data$dog_b[i] <- avgeraged_threats$dogs_bi
nest_data_MP_with_threat_data$don_b[i] <- avgeraged_threats$dogs_on_bi
nest_data_MP_with_threat_data$dof_b[i] <- avgeraged_threats$dogs_off_bi
nest_data_MP_with_threat_data$pbd_b[i] <- avgeraged_threats$p_birds_bi
nest_data_MP_with_threat_data$hof_b[i] <- avgeraged_threats$hoof_bi
nest_data_MP_with_threat_data$hum_p[i] <- avgeraged_threats$hum_pr
nest_data_MP_with_threat_data$veh_p[i] <- avgeraged_threats$vehicle_pr
nest_data_MP_with_threat_data$dog_p[i] <- avgeraged_threats$dog_pr
nest_data_MP_with_threat_data$hof_p[i] <- avgeraged_threats$hoof_pr
nest_data_MP_with_threat_data$fox_p[i] <- avgeraged_threats$fox_pr
nest_data_MP_with_threat_data$n_surveys[i] <- avgeraged_threats$n_surveys
nest_data_MP_with_threat_data$days_active[i] <- avgeraged_threats$days_active
nest_data_MP_with_threat_data$halfway[i] <- avgeraged_threats$halfway
nest_data_MP_with_threat_data$uncertain_days[i] <- avgeraged_threats$uncertain_days
}else{
nest_data_MP_with_threat_data$hum_a[i] <- NA
nest_data_MP_with_threat_data$veh_a[i] <- NA
nest_data_MP_with_threat_data$dog_a[i] <- NA
nest_data_MP_with_threat_data$don_a[i] <- NA
nest_data_MP_with_threat_data$dof_a[i] <- NA
nest_data_MP_with_threat_data$hof_a[i] <- NA
nest_data_MP_with_threat_data$pbd_a[i] <- NA
nest_data_MP_with_threat_data$hum_m[i] <- NA
nest_data_MP_with_threat_data$veh_m[i] <- NA
nest_data_MP_with_threat_data$dog_m[i] <- NA
nest_data_MP_with_threat_data$don_m[i] <- NA
nest_data_MP_with_threat_data$dof_m[i] <- NA
nest_data_MP_with_threat_data$hof_m[i] <- NA
nest_data_MP_with_threat_data$pbd_m[i] <- NA
nest_data_MP_with_threat_data$hum_b[i] <- NA
nest_data_MP_with_threat_data$veh_b[i] <- NA
nest_data_MP_with_threat_data$dog_b[i] <- NA
nest_data_MP_with_threat_data$don_b[i] <- NA
nest_data_MP_with_threat_data$dof_b[i] <- NA
nest_data_MP_with_threat_data$pbd_b[i] <- NA
nest_data_MP_with_threat_data$hof_b[i] <- NA
nest_data_MP_with_threat_data$hum_p[i] <- NA
nest_data_MP_with_threat_data$veh_p[i] <- NA
nest_data_MP_with_threat_data$dog_p[i] <- NA
nest_data_MP_with_threat_data$hof_p[i] <- NA
nest_data_MP_with_threat_data$fox_p[i] <- NA
nest_data_MP_with_threat_data$n_surveys[i] <- 0
nest_data_MP_with_threat_data$days_active[i] <- days_active
nest_data_MP_with_threat_data$halfway[i] <- halfway
nest_data_MP_with_threat_data$uncertain_days[i] <- uncertain_days
nest_data_MP_with_threat_data$fundays[i] <- NA
}
}Bellarine / Surf Coast: summarise threat data
Code
nest_data_BSC_with_threat_data <-
nest_data_BSC %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_BSC$season_site) %>%
dplyr::select(season, site, region, nest_ID,
FirstFound, LastPresent, LastChecked,
first_found2, last_alive2, last_checked2,
management_status, management_level,
nest_hab, Fate) %>%
rename(status = management_status,
level = management_level) %>%
mutate(level = paste0("L", level)) %>%
mutate(level = factor(level,
levels = c("L0", "L1",
"L2", "L3",
"L4"))) %>%
ungroup() %>%
mutate(
hum_a = NA,
veh_a = NA,
dog_a = NA,
don_a = NA,
dof_a = NA,
hof_a = NA,
pbd_a = NA,
hum_m = NA,
veh_m = NA,
dog_m = NA,
don_m = NA,
dof_m = NA,
hof_m = NA,
pbd_m = NA,
hum_b = NA,
veh_b = NA,
dog_b = NA,
don_b = NA,
dof_b = NA,
pbd_b = NA,
hof_b = NA,
hum_p = NA,
veh_p = NA,
dog_p = NA,
hof_p = NA,
fox_p = NA,
n_surveys = NA,
days_active = NA,
fundays = NA,
uncertain_days = NA,
halfway = NA) %>%
filter(FirstFound <= LastPresent & FirstFound <= LastChecked & LastPresent <= LastChecked) %>%
filter(first_found2 <= last_alive2 & first_found2 <= last_checked2 & last_alive2 <= last_checked2)
BSC_threat_data_subset <-
threat_data__ %>%
filter(region == "BSC") %>%
mutate(season_site = paste(season, site, sep = "_")) %>%
filter(season_site %in% sites_intersect_BSC$season_site) %>%
ungroup()
for(i in 1:nrow(nest_data_BSC_with_threat_data)){
FirstFound <- nest_data_BSC_with_threat_data$FirstFound[i]
LastPresent <- nest_data_BSC_with_threat_data$LastPresent[i]
LastChecked <- nest_data_BSC_with_threat_data$LastChecked[i]
FirstFound2 <- nest_data_BSC_with_threat_data$first_found2[i]
LastPresent2 <- nest_data_BSC_with_threat_data$last_alive2[i]
LastChecked2 <- nest_data_BSC_with_threat_data$last_checked2[i]
halfway <- (LastChecked - LastPresent)/2
days_active <- (LastPresent + halfway) - FirstFound
uncertain_days <- LastChecked - LastPresent
site_ <- as.character(nest_data_BSC_with_threat_data$site[i])
season_ <- as.character(nest_data_BSC_with_threat_data$season[i])
fundays_df <-
data.frame(date = seq(from = LastPresent2, to = LastChecked2, 1)) %>%
# mutate(weekday = weekdays(dates)) %>%
mutate(weekday = factor(as.factor(weekdays(date)),
levels = c("Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday",
"Sunday")),
region = "FP") %>%
mutate(year = year(date)) %>%
mutate(season = ifelse(month(date) < 6, year - 1, year)) %>%
mutate(season = ifelse(month(date) >= 6,
paste0(year, substr(year + 1, 3, 4)),
paste0(season, substr(year, 3, 4)))) %>%
left_join(., holidays, by = c("region", "season"), relationship = "many-to-many") %>%
mutate(holiday = ifelse(date >= start_date & date <= end_date, 1, 0)) %>%
group_by(region, season, date) %>%
mutate(holiday = max(holiday, na.rm = TRUE)) %>%
dplyr::select(-c(event, start_date, end_date)) %>%
distinct() %>%
ungroup() %>%
mutate(day_type = ifelse(holiday == 1 | weekday %in%
c("Saturday", "Sunday"), "funday", "workday")) %>%
mutate(funday = ifelse(day_type == "funday", 1, 0))
BSC_threat_data_subset_ <-
BSC_threat_data_subset %>%
ungroup() %>%
# data.frame() %>%
# dplyr::filter(as.numeric(obs_date2) >= FirstFound & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
# dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + halfway) & season == season_) %>%
dplyr::filter(as.numeric(obs_date2) >= LastPresent & as.numeric(obs_date2) <= (LastPresent + (LastChecked - LastPresent)) & season == season_) %>%
dplyr::filter(site == site_)
if(nrow(BSC_threat_data_subset_) > 0){
avgeraged_threats <-
BSC_threat_data_subset_ %>%
mutate(hum_bi = ifelse(humans > 0 | (!is.na(hum_pri)), 1, 0),
vehicle_bi = ifelse(vehicles > 0 | (!is.na(vehicle_pri)), 1, 0),
dogs_bi = ifelse(dogs > 0 | (!is.na(dog_pri)), 1, 0),
dogs_off_bi = ifelse(dogs_off > 0, 1, 0),
dogs_on_bi = ifelse(dogs_on > 0, 1, 0),
p_birds_bi = ifelse(pred_birds > 0, 1, 0),
hoof_bi = ifelse(hoofed_animals > 0 | (!is.na(hoofed_pri)), 1, 0)) %>%
dplyr::summarise(
# fundays = sum(funday),
hum_avg = mean(humans, na.rm = TRUE),
vehicles_avg = mean(vehicles, na.rm = TRUE),
dogs_avg = mean(dogs, na.rm = TRUE),
dogs_on_avg = mean(dogs_on, na.rm = TRUE),
dogs_off_avg = mean(dogs_off, na.rm = TRUE),
hoof_avg = mean(hoofed_animals, na.rm = TRUE),
p_birds_avg = mean(pred_birds, na.rm = TRUE),
hum_max = max(humans, na.rm = TRUE),
vehicles_max = max(vehicles, na.rm = TRUE),
dogs_max = max(dogs, na.rm = TRUE),
dogs_on_max = max(dogs_on, na.rm = TRUE),
dogs_off_max = max(dogs_off, na.rm = TRUE),
hoof_max = max(hoofed_animals, na.rm = TRUE),
p_birds_max = max(pred_birds, na.rm = TRUE),
hum_bi = max(hum_bi, na.rm = TRUE),
vehicle_bi = max(vehicle_bi, na.rm = TRUE),
dogs_bi = max(dogs_bi, na.rm = TRUE),
dogs_on_bi = max(dogs_on_bi, na.rm = TRUE),
dogs_off_bi = max(dogs_off_bi, na.rm = TRUE),
p_birds_bi = max(p_birds_bi, na.rm = TRUE),
hoof_bi = max(hoof_bi, na.rm = TRUE),
hum_pr = mean(hum_pri, na.rm = TRUE),
vehicle_pr = mean(vehicle_pri, na.rm = TRUE),
dog_pr = mean(dog_pri, na.rm = TRUE),
hoof_pr = mean(hoofed_pri, na.rm = TRUE),
fox_pr = mean(fox_pri, na.rm = TRUE),
n_surveys = n(),
days_active = days_active,
halfway = halfway,
uncertain_days = uncertain_days)
nest_data_BSC_with_threat_data$fundays[i] <- sum(fundays_df$funday)
nest_data_BSC_with_threat_data$hum_a[i] <- avgeraged_threats$hum_avg
nest_data_BSC_with_threat_data$veh_a[i] <- avgeraged_threats$vehicles_avg
nest_data_BSC_with_threat_data$dog_a[i] <- avgeraged_threats$dogs_avg
nest_data_BSC_with_threat_data$don_a[i] <- avgeraged_threats$dogs_on_avg
nest_data_BSC_with_threat_data$dof_a[i] <- avgeraged_threats$dogs_off_avg
nest_data_BSC_with_threat_data$hof_a[i] <- avgeraged_threats$hoof_avg
nest_data_BSC_with_threat_data$pbd_a[i] <- avgeraged_threats$p_birds_avg
nest_data_BSC_with_threat_data$hum_m[i] <- avgeraged_threats$hum_max
nest_data_BSC_with_threat_data$veh_m[i] <- avgeraged_threats$vehicles_max
nest_data_BSC_with_threat_data$dog_m[i] <- avgeraged_threats$dogs_max
nest_data_BSC_with_threat_data$don_m[i] <- avgeraged_threats$dogs_on_max
nest_data_BSC_with_threat_data$dof_m[i] <- avgeraged_threats$dogs_off_max
nest_data_BSC_with_threat_data$hof_m[i] <- avgeraged_threats$hoof_max
nest_data_BSC_with_threat_data$pbd_m[i] <- avgeraged_threats$p_birds_max
nest_data_BSC_with_threat_data$hum_b[i] <- avgeraged_threats$hum_bi
nest_data_BSC_with_threat_data$veh_b[i] <- avgeraged_threats$vehicle_bi
nest_data_BSC_with_threat_data$dog_b[i] <- avgeraged_threats$dogs_bi
nest_data_BSC_with_threat_data$don_b[i] <- avgeraged_threats$dogs_on_bi
nest_data_BSC_with_threat_data$dof_b[i] <- avgeraged_threats$dogs_off_bi
nest_data_BSC_with_threat_data$pbd_b[i] <- avgeraged_threats$p_birds_bi
nest_data_BSC_with_threat_data$hof_b[i] <- avgeraged_threats$hoof_bi
nest_data_BSC_with_threat_data$hum_p[i] <- avgeraged_threats$hum_pr
nest_data_BSC_with_threat_data$veh_p[i] <- avgeraged_threats$vehicle_pr
nest_data_BSC_with_threat_data$dog_p[i] <- avgeraged_threats$dog_pr
nest_data_BSC_with_threat_data$hof_p[i] <- avgeraged_threats$hoof_pr
nest_data_BSC_with_threat_data$fox_p[i] <- avgeraged_threats$fox_pr
nest_data_BSC_with_threat_data$n_surveys[i] <- avgeraged_threats$n_surveys
nest_data_BSC_with_threat_data$days_active[i] <- avgeraged_threats$days_active
nest_data_BSC_with_threat_data$halfway[i] <- avgeraged_threats$halfway
nest_data_BSC_with_threat_data$uncertain_days[i] <- avgeraged_threats$uncertain_days
}else{
nest_data_BSC_with_threat_data$hum_a[i] <- NA
nest_data_BSC_with_threat_data$veh_a[i] <- NA
nest_data_BSC_with_threat_data$dog_a[i] <- NA
nest_data_BSC_with_threat_data$don_a[i] <- NA
nest_data_BSC_with_threat_data$dof_a[i] <- NA
nest_data_BSC_with_threat_data$hof_a[i] <- NA
nest_data_BSC_with_threat_data$pbd_a[i] <- NA
nest_data_BSC_with_threat_data$hum_m[i] <- NA
nest_data_BSC_with_threat_data$veh_m[i] <- NA
nest_data_BSC_with_threat_data$dog_m[i] <- NA
nest_data_BSC_with_threat_data$don_m[i] <- NA
nest_data_BSC_with_threat_data$dof_m[i] <- NA
nest_data_BSC_with_threat_data$hof_m[i] <- NA
nest_data_BSC_with_threat_data$pbd_m[i] <- NA
nest_data_BSC_with_threat_data$hum_b[i] <- NA
nest_data_BSC_with_threat_data$veh_b[i] <- NA
nest_data_BSC_with_threat_data$dog_b[i] <- NA
nest_data_BSC_with_threat_data$don_b[i] <- NA
nest_data_BSC_with_threat_data$dof_b[i] <- NA
nest_data_BSC_with_threat_data$pbd_b[i] <- NA
nest_data_BSC_with_threat_data$hof_b[i] <- NA
nest_data_BSC_with_threat_data$hum_p[i] <- NA
nest_data_BSC_with_threat_data$veh_p[i] <- NA
nest_data_BSC_with_threat_data$dog_p[i] <- NA
nest_data_BSC_with_threat_data$hof_p[i] <- NA
nest_data_BSC_with_threat_data$fox_p[i] <- NA
nest_data_BSC_with_threat_data$n_surveys[i] <- 0
nest_data_BSC_with_threat_data$days_active[i] <- days_active
nest_data_BSC_with_threat_data$halfway[i] <- halfway
nest_data_BSC_with_threat_data$uncertain_days[i] <- uncertain_days
nest_data_BSC_with_threat_data$fundays[i] <- NA
}
}remove outlier data and those with very infrequent threat surveys
Code
nest_data_with_threat_data <-
bind_rows(nest_data_FP_with_threat_data,
nest_data_MP_with_threat_data,
nest_data_BSC_with_threat_data) %>%
filter(n_surveys > 0) %>%
# mutate(dof_b = ifelse(dof_b == 1, "Y", "N")) %>%
# dplyr::select(-fox_p) %>%
mutate_at(vars(hum_b, veh_b, dog_b, don_b, dof_b, pbd_b, hof_b),
~ as.factor(.)) %>%
mutate_at(vars(hum_p, veh_p, dog_p, hof_p),
~ ifelse(is.na(.), 0, .))
nest_data_with_threat_data %>% filter(fundays > 10) %>% dplyr::select(fundays)# A tibble: 91 × 1
fundays
<dbl>
1 19
2 15
3 19
4 12
5 20
6 15
7 26
8 26
9 20
10 18
# ℹ 81 more rowsCode
nest_data_with_threat_data %>%
filter(fundays <= 25) %>%
ggplot() +
geom_histogram(aes(fundays)) +
# geom_vline(xintercept = log(10), color = "red") +
luke_theme
Code
nest_data_with_threat_data %>%
ggplot() +
geom_histogram(aes(halfway/n_surveys), binwidth = 1)
Code
nest_data_with_threat_data_5d <-
nest_data_with_threat_data %>%
filter(halfway/n_surveys <= 5) %>%
filter(fundays < 100)
#### check variable distributions and collinearity ----
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(hum_a), binwidth = 5)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(veh_a), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(dog_a), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(don_a), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(dof_a), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(hum_m), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(veh_m), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(dog_m), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(don_m), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(dof_m), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(hum_p), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(veh_p), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(dog_p), binwidth = 1)
Code
nest_data_with_threat_data_5d %>%
ggplot() +
geom_histogram(aes(hof_p), binwidth = 1)
Prepare data for RMark
Code
occ_FP <-
nest_data_with_threat_data_5d %>%
filter(region == "FP") %>%
pull(LastChecked) %>%
max(., na.rm = TRUE)
occ_MP <-
nest_data_with_threat_data_5d %>%
filter(region == "MP") %>%
pull(LastChecked) %>%
max(., na.rm = TRUE)
occ_BSC <-
nest_data_with_threat_data_5d %>%
filter(region == "BSC") %>%
pull(LastChecked) %>%
max(., na.rm = TRUE)
# create processed RMARK data format as NestSurvival with Year as group
nest_data.processed_FP_5d <-
RMark::process.data(nest_data_with_threat_data_5d %>% filter(region == "FP"),
model = "Nest",
nocc = occ_FP, groups = c("season",
"nest_hab",
"status",
"site",
"level"))
nest_data.processed_MP_5d <-
RMark::process.data(nest_data_with_threat_data_5d %>% filter(region == "MP"),
model = "Nest",
nocc = occ_MP, groups = c("season",
"nest_hab",
"status",
"site",
"level"))
nest_data.processed_BSC_5d <-
RMark::process.data(nest_data_with_threat_data_5d %>% filter(region == "BSC"),
model = "Nest",
nocc = occ_BSC, groups = c("season",
"nest_hab",
"status",
"site",
"level"))
# create the design data
nest_fate.ddl_FP_5d <- RMark::make.design.data(nest_data.processed_FP_5d)
nest_fate.ddl_MP_5d <- RMark::make.design.data(nest_data.processed_MP_5d)
nest_fate.ddl_BSC_5d <- RMark::make.design.data(nest_data.processed_BSC_5d)
# add a new variable to the design data that is the quadratic transformation of
# time
time <- c(0:(occ_FP-1))
Cubic <- time^3
Quadratic <- time^2
quad_time <- data.frame(time, Quadratic, Cubic)
quad_time$time <- c(1:occ_FP)
nest_fate.ddl_FP_5d$S <-
RMark::merge_design.covariates(nest_fate.ddl_FP_5d$S, quad_time,
bygroup = FALSE, bytime = TRUE)
time <- c(0:(occ_MP-1))
Cubic <- time^3
Quadratic <- time^2
quad_time <- data.frame(time, Quadratic, Cubic)
quad_time$time <- c(1:occ_MP)
nest_fate.ddl_MP_5d$S <-
RMark::merge_design.covariates(nest_fate.ddl_MP_5d$S, quad_time,
bygroup = FALSE, bytime = TRUE)
time <- c(0:(occ_BSC-1))
Cubic <- time^3
Quadratic <- time^2
quad_time <- data.frame(time, Quadratic, Cubic)
quad_time$time <- c(1:occ_BSC)
nest_fate.ddl_BSC_5d$S <-
RMark::merge_design.covariates(nest_fate.ddl_BSC_5d$S, quad_time,
bygroup = FALSE, bytime = TRUE)
# nest_fate.ddl$S <-
# RMark::merge_design.covariates(nest_fate.ddl$S, data.frame(management_level = c(0, 1, 2, 3, 4)),
# bygroup = FALSE, bytime = FALSE)
# nest_fate.ddl$S <-
# inner_join(nest_fate.ddl$S, int_threat_data, by = c("site", "time"))
RMark_data_FP <-
list(nest_data.processed = nest_data.processed_FP_5d,
nest_fate.ddl = nest_fate.ddl_FP_5d)
RMark_data_MP <-
list(nest_data.processed = nest_data.processed_MP_5d,
nest_fate.ddl = nest_fate.ddl_MP_5d)
RMark_data_BSC <-
list(nest_data.processed = nest_data.processed_BSC_5d,
nest_fate.ddl = nest_fate.ddl_BSC_5d)
RMark_data_FP$nest_data.processed$data %>% summary() season site region nest_ID
202021 :81 Yilki : 31 Length:437 Length:437
201920 :70 Inman River Outlet : 29 Class :character Class :character
201819 :68 Watsons Gap : 27 Mode :character Mode :character
201718 :50 Ochre Cove, Maslins: 25
201617 :42 Maslin Beach : 21
201516 :30 Port Willunga : 21
(Other):96 (Other) :283
FirstFound LastPresent LastChecked first_found2
Min. : 34 Min. : 44.0 Min. : 45.0 Min. :2010-08-21
1st Qu.: 87 1st Qu.:101.0 1st Qu.:105.0 1st Qu.:2015-11-01
Median :127 Median :139.0 Median :141.0 Median :2018-08-19
Mean :125 Mean :138.5 Mean :141.7 Mean :2017-08-04
3rd Qu.:160 3rd Qu.:177.0 3rd Qu.:180.0 3rd Qu.:2019-11-10
Max. :233 Max. :245.0 Max. :245.0 Max. :2021-02-22
last_alive2 last_checked2 status level nest_hab
Min. :2010-09-09 Min. :2010-09-09 N:115 L0: 93 Beach :288
1st Qu.:2015-11-23 1st Qu.:2015-11-24 Y:322 L1: 29 Foredune/face:104
Median :2018-09-04 Median :2018-09-10 y: 0 L2: 17 Dune : 45
Mean :2017-08-17 Mean :2017-08-20 L3:289 Not found : 0
3rd Qu.:2019-11-28 3rd Qu.:2019-12-01 L4: 9 Estuary/spit : 0
Max. :2021-03-04 Max. :2021-03-04 Not specified: 0
(Other) : 0
Fate hum_a veh_a dog_a
Min. :0.0000 Min. : 0.000 Min. : 0.000 Min. : 0.000
1st Qu.:0.0000 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.000
Median :1.0000 Median : 1.500 Median : 0.000 Median : 0.000
Mean :0.6613 Mean : 7.907 Mean : 1.593 Mean : 1.555
3rd Qu.:1.0000 3rd Qu.: 5.000 3rd Qu.: 0.000 3rd Qu.: 2.000
Max. :1.0000 Max. :738.000 Max. :510.000 Max. :67.000
don_a dof_a hof_a pbd_a
Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 Min. : 0.00
1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.00
Median : 0.0000 Median : 0.0000 Median : 0.0000 Median : 3.00
Mean : 0.6499 Mean : 0.9315 Mean : 0.2895 Mean : 12.48
3rd Qu.: 0.5000 3rd Qu.: 1.0000 3rd Qu.: 0.0000 3rd Qu.: 7.00
Max. :32.0000 Max. :35.0000 Max. :85.0000 Max. :300.00
hum_m veh_m dog_m don_m
Min. : 0.000 Min. : 0.000 Min. : 0.000 Min. : 0.0000
1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.0000
Median : 2.000 Median : 0.000 Median : 0.000 Median : 0.0000
Mean : 9.421 Mean : 1.689 Mean : 1.934 Mean : 0.8146
3rd Qu.: 7.000 3rd Qu.: 0.000 3rd Qu.: 2.000 3rd Qu.: 1.0000
Max. :738.000 Max. :510.000 Max. :67.000 Max. :32.0000
dof_m hof_m pbd_m hum_b veh_b dog_b
Min. : 0.000 Min. : 0.0000 Min. : 0.00 0: 73 0:391 0:153
1st Qu.: 0.000 1st Qu.: 0.0000 1st Qu.: 0.00 1:364 1: 46 1:284
Median : 0.000 Median : 0.0000 Median : 3.00
Mean : 1.188 Mean : 0.3661 Mean : 16.35
3rd Qu.: 1.000 3rd Qu.: 0.0000 3rd Qu.: 10.00
Max. :35.000 Max. :100.0000 Max. :400.00
don_b dof_b pbd_b hof_b hum_p veh_p
0:312 0:291 0:120 0:417 Min. :0.000 Min. :0.0000
1:125 1:146 1:317 1: 20 1st Qu.:1.000 1st Qu.:0.0000
Median :1.000 Median :0.0000
Mean :1.215 Mean :0.1682
3rd Qu.:2.000 3rd Qu.:0.0000
Max. :3.000 Max. :3.0000
dog_p hof_p fox_p n_surveys
Min. :0.0000 Min. :0.00000 Min. :1.000 Min. :1.000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:1.000 1st Qu.:1.000
Median :1.0000 Median :0.00000 Median :1.000 Median :2.000
Mean :0.8307 Mean :0.06979 Mean :1.199 Mean :1.634
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:1.000 3rd Qu.:2.000
Max. :3.0000 Max. :3.00000 Max. :3.000 Max. :4.000
NA's :291
days_active fundays uncertain_days halfway
Min. : 0.00 Min. : 0.000 Min. : 0.00 Min. : 0.000
1st Qu.: 6.00 1st Qu.: 1.000 1st Qu.: 0.00 1st Qu.: 0.000
Median :12.50 Median : 1.000 Median : 1.00 Median : 0.500
Mean :15.09 Mean : 2.293 Mean : 3.11 Mean : 1.555
3rd Qu.:25.00 3rd Qu.: 3.000 3rd Qu.: 4.00 3rd Qu.: 2.000
Max. :53.00 Max. :21.000 Max. :20.00 Max. :10.000
group
174 : 6
247 : 6
71 : 5
142 : 5
165 : 5
246 : 5
(Other):405 Code
RMark_data_MP$nest_data.processed$data %>% summary() season site region
201617 : 91 Koonya West : 40 Length:652
201516 : 76 St Andrews Boags Rocks : 37 Class :character
202021 : 70 Koonya East : 35 Mode :character
201718 : 63 Montforts : 23
201415 : 62 Moana crt access west : 23
201819 : 53 Portsea Franklin rd west: 23
(Other):237 (Other) :471
nest_ID FirstFound LastPresent LastChecked
Length:652 Min. : 54.0 Min. : 58.0 Min. : 60.0
Class :character 1st Qu.:108.0 1st Qu.:121.0 1st Qu.:124.8
Mode :character Median :143.5 Median :158.5 Median :162.0
Mean :141.2 Mean :154.7 Mean :158.4
3rd Qu.:172.0 3rd Qu.:185.0 3rd Qu.:189.2
Max. :241.0 Max. :241.0 Max. :249.0
first_found2 last_alive2 last_checked2 status
Min. :2006-09-15 Min. :2006-09-20 Min. :2006-09-25 N:168
1st Qu.:2012-12-21 1st Qu.:2013-01-03 1st Qu.:2013-01-13 Y:484
Median :2015-12-07 Median :2015-12-28 Median :2015-12-30 y: 0
Mean :2015-07-27 Mean :2015-08-10 Mean :2015-08-14
3rd Qu.:2017-12-20 3rd Qu.:2018-01-02 3rd Qu.:2018-01-06
Max. :2021-01-27 Max. :2021-02-19 Max. :2021-02-19
level nest_hab Fate hum_a
L0:119 Beach :261 Min. :0.0000 Min. : 0.0
L1: 50 Dune :221 1st Qu.:0.0000 1st Qu.: 0.0
L2: 71 Foredune/face:162 Median :1.0000 Median : 0.5
L3:411 Rocks : 8 Mean :0.6887 Mean : 3.6
L4: 1 Not found : 0 3rd Qu.:1.0000 3rd Qu.: 3.0
Estuary/spit : 0 Max. :1.0000 Max. :410.5
(Other) : 0
veh_a dog_a don_a dof_a
Min. :0.000000 Min. :0.0000 Min. :0.00000 Min. :0.00000
1st Qu.:0.000000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.000000 Median :0.0000 Median :0.00000 Median :0.00000
Mean :0.003195 Mean :0.1451 Mean :0.05181 Mean :0.09325
3rd Qu.:0.000000 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.000000 Max. :8.0000 Max. :4.50000 Max. :5.50000
hof_a pbd_a hum_m veh_m
Min. : 0.0000 Min. : 0.000 Min. : 0.000 Min. :0.000000
1st Qu.: 0.0000 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.:0.000000
Median : 0.0000 Median : 0.000 Median : 1.000 Median :0.000000
Mean : 0.1766 Mean : 2.764 Mean : 5.537 Mean :0.006135
3rd Qu.: 0.0000 3rd Qu.: 2.812 3rd Qu.: 4.250 3rd Qu.:0.000000
Max. :15.0000 Max. :259.000 Max. :815.000 Max. :1.000000
dog_m don_m dof_m hof_m
Min. : 0.0000 Min. :0.00000 Min. :0.0000 Min. : 0.0000
1st Qu.: 0.0000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.: 0.0000
Median : 0.0000 Median :0.00000 Median :0.0000 Median : 0.0000
Mean : 0.2193 Mean :0.07515 Mean :0.1457 Mean : 0.2868
3rd Qu.: 0.0000 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.: 0.0000
Max. :13.0000 Max. :7.00000 Max. :9.0000 Max. :23.0000
pbd_m hum_b veh_b dog_b don_b dof_b pbd_b hof_b
Min. : 0.00 0:174 0:640 0:431 0:619 0:615 0:338 0:603
1st Qu.: 0.00 1:478 1: 12 1:221 1: 33 1: 37 1:314 1: 49
Median : 0.00
Mean : 3.96
3rd Qu.: 4.00
Max. :259.00
hum_p veh_p dog_p hof_p
Min. :0.000 Min. :0.00000 Min. :0.0000 Min. :0.0000
1st Qu.:0.000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000
Median :1.000 Median :0.00000 Median :0.0000 Median :0.0000
Mean :1.088 Mean :0.01994 Mean :0.4225 Mean :0.1265
3rd Qu.:2.000 3rd Qu.:0.00000 3rd Qu.:1.0000 3rd Qu.:0.0000
Max. :3.000 Max. :3.00000 Max. :3.0000 Max. :3.0000
fox_p n_surveys days_active fundays
Min. :1.000 Min. :1.000 Min. : 0.00 Min. : 0.000
1st Qu.:1.000 1st Qu.:1.000 1st Qu.: 6.50 1st Qu.: 1.000
Median :1.000 Median :2.000 Median :14.75 Median : 2.000
Mean :1.302 Mean :1.722 Mean :15.41 Mean : 2.752
3rd Qu.:1.500 3rd Qu.:2.000 3rd Qu.:24.00 3rd Qu.: 4.000
Max. :3.000 Max. :7.000 Max. :62.00 Max. :27.000
NA's :451
uncertain_days halfway group
Min. : 0.000 Min. : 0.000 385 : 5
1st Qu.: 0.000 1st Qu.: 0.000 9 : 4
Median : 3.000 Median : 1.500 406 : 4
Mean : 3.712 Mean : 1.856 418 : 4
3rd Qu.: 6.000 3rd Qu.: 3.000 13 : 3
Max. :33.000 Max. :16.500 36 : 3
(Other):629 Code
RMark_data_BSC$nest_data.processed$data %>% summary() season site region
202021 : 55 Black Rock : 20 Length:370
201617 : 51 Point Roadknight West (96W - 98W): 18 Class :character
201718 : 46 Pt Roadknight Tip (95W) : 18 Mode :character
201920 : 46 Collendina Pt Lons. pair (NZ&unb): 16
201819 : 42 13th Beach 40W-42W : 16
201112 : 24 Point Roadknight Tip (95W) : 14
(Other):106 (Other) :268
nest_ID FirstFound LastPresent LastChecked
Length:370 Min. : 51.0 Min. : 56.0 Min. : 60.0
Class :character 1st Qu.:115.0 1st Qu.:123.0 1st Qu.:126.0
Mode :character Median :148.5 Median :160.0 Median :163.5
Mean :145.5 Mean :156.4 Mean :160.1
3rd Qu.:179.0 3rd Qu.:191.0 3rd Qu.:194.0
Max. :230.0 Max. :249.0 Max. :261.0
first_found2 last_alive2 last_checked2 status
Min. :2001-01-05 Min. :2006-09-18 Min. :2006-09-22 N: 55
1st Qu.:2014-01-17 1st Qu.:2014-02-10 1st Qu.:2014-02-13 Y:315
Median :2017-10-08 Median :2017-10-12 Median :2017-10-18 y: 0
Mean :2016-07-19 Mean :2016-08-09 Mean :2016-08-13
3rd Qu.:2019-10-13 3rd Qu.:2019-10-24 3rd Qu.:2019-10-30
Max. :2021-02-16 Max. :2021-03-03 Max. :2021-03-03
level nest_hab Fate hum_a
L0: 19 Beach :153 Min. :0.0000 Min. : 0.000
L1: 37 Dune :116 1st Qu.:0.0000 1st Qu.: 0.000
L2: 79 Foredune/face:101 Median :1.0000 Median : 0.000
L3:232 Not found : 0 Mean :0.7243 Mean : 3.617
L4: 3 Estuary/spit : 0 3rd Qu.:1.0000 3rd Qu.: 2.500
Not specified: 0 Max. :1.0000 Max. :405.000
(Other) : 0
veh_a dog_a don_a dof_a
Min. :0.0000 Min. : 0.0000 Min. : 0.0000 Min. : 0.0000
1st Qu.:0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000
Median :0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000
Mean :0.0446 Mean : 0.6568 Mean : 0.2554 Mean : 0.4014
3rd Qu.:0.0000 3rd Qu.: 0.5000 3rd Qu.: 0.0000 3rd Qu.: 0.2500
Max. :8.0000 Max. :23.0000 Max. :18.0000 Max. :15.0000
hof_a pbd_a hum_m veh_m
Min. :0.00000 Min. : 0.000 Min. : 0.000 Min. :0.00000
1st Qu.:0.00000 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.:0.00000
Median :0.00000 Median : 0.000 Median : 0.000 Median :0.00000
Mean :0.01892 Mean : 3.931 Mean : 4.368 Mean :0.05405
3rd Qu.:0.00000 3rd Qu.: 2.000 3rd Qu.: 4.000 3rd Qu.:0.00000
Max. :4.00000 Max. :350.000 Max. :405.000 Max. :8.00000
dog_m don_m dof_m hof_m
Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 Min. :0.00000
1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.:0.00000
Median : 0.0000 Median : 0.0000 Median : 0.0000 Median :0.00000
Mean : 0.8622 Mean : 0.3351 Mean : 0.5514 Mean :0.02703
3rd Qu.: 1.0000 3rd Qu.: 0.0000 3rd Qu.: 0.7500 3rd Qu.:0.00000
Max. :31.0000 Max. :18.0000 Max. :30.0000 Max. :4.00000
pbd_m hum_b veh_b dog_b don_b dof_b pbd_b hof_b
Min. : 0.000 0:164 0:364 0:219 0:321 0:277 0:235 0:363
1st Qu.: 0.000 1:206 1: 6 1:151 1: 49 1: 93 1:135 1: 7
Median : 0.000
Mean : 6.089
3rd Qu.: 3.000
Max. :700.000
hum_p veh_p dog_p hof_p
Min. :0.0000 Min. :0.00000 Min. :0.0000 Min. :0.00000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.00000
Median :0.0000 Median :0.00000 Median :0.0000 Median :0.00000
Mean :0.4784 Mean :0.01351 Mean :0.3014 Mean :0.01892
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.00000
Max. :3.0000 Max. :2.00000 Max. :3.0000 Max. :2.00000
fox_p n_surveys days_active fundays
Min. :1.000 Min. :1.000 Min. : 0.00 Min. : 0.000
1st Qu.:1.000 1st Qu.:1.000 1st Qu.: 4.00 1st Qu.: 1.000
Median :1.000 Median :2.000 Median : 9.50 Median : 2.000
Mean :1.357 Mean :1.662 Mean :12.76 Mean : 2.578
3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:20.00 3rd Qu.: 3.000
Max. :2.000 Max. :8.000 Max. :64.00 Max. :24.000
NA's :342
uncertain_days halfway group
Min. : 0.000 Min. : 0.000 217 : 4
1st Qu.: 0.000 1st Qu.: 0.000 224 : 4
Median : 3.000 Median : 1.500 226 : 4
Mean : 3.754 Mean : 1.877 273 : 4
3rd Qu.: 5.000 3rd Qu.: 2.500 49 : 3
Max. :49.000 Max. :24.500 67 : 3
(Other):348 Fleurieu Peninsula model selection
Code
nest_survival_FP <- function()
{
# Specify models to test
# constant daily survival rate (DSR)
S.dot <-
list(formula = ~1)
# Linear trend in DSR
S.Time <-
list(formula = ~Time)
# Quadratic trend in DSR
S.Quadratic_Time <-
list(formula = ~Time + Quadratic)
# Cubic trend in DSR
S.Cubic_Time <-
list(formula = ~Time + Quadratic + Cubic)
# Linear trend in DSR
S.fundays <-
list(formula = ~fundays)
# Linear trend in DSR
S.fundays_level <-
list(formula = ~fundays + level)
#### average counts
# average humans detected
S.hum_a <-
list(formula = ~hum_a)
# average vehicles detected
S.veh_a <-
list(formula = ~veh_a)
# average dogs detected
S.dog_a <-
list(formula = ~dog_a)
# average dogs off leash detected
S.dof_a <-
list(formula = ~dof_a)
# average hoofed animals detected
S.hof_a <-
list(formula = ~hof_a)
# average hoofed animals detected
S.pbd_a <-
list(formula = ~pbd_a)
#### maximum counts
# max humans detected
S.hum_m <-
list(formula = ~hum_m)
# max vehicles detected
S.veh_m <-
list(formula = ~veh_m)
# max dogs detected
S.dog_m <-
list(formula = ~dog_m)
# max dogs off leash detected
S.dof_m <-
list(formula = ~dof_m)
# max predatory birds detected
S.pbd_m <-
list(formula = ~pbd_m)
#### interaction with management levels
# average humans detected
S.hum_a_level <-
list(formula = ~hum_a + level)
# average vehicles detected
S.veh_a_level <-
list(formula = ~veh_a + level)
# average dogs detected
S.dog_a_level <-
list(formula = ~dog_a + level)
# average dogs off leash detected
S.dof_a_level <-
list(formula = ~dof_a + level)
# average predatory birds detected
S.pbd_a_level <-
list(formula = ~pbd_a + level)
#### interaction with management levels
# max humans detected
S.hum_m_level <-
list(formula = ~hum_m + level)
# max vehicles detected
S.veh_m_level <-
list(formula = ~veh_m + level)
# max dogs detected
S.dog_m_level <-
list(formula = ~dog_m + level)
# max dogs off leash detected
S.dof_m_level <-
list(formula = ~dof_m + level)
# max predatory birds detected
S.pbd_m_level <-
list(formula = ~pbd_m + level)
# annual variation in DSR
S.season <-
list(formula = ~season)
# Cubic trend and annual variation DSR
S.Cubic_Time_season <-
list(formula = ~Time + Quadratic + Cubic + season)
# habitat-specific variation in DSR
S.habitat <-
list(formula = ~nest_hab)
# Cubic trend habitat-specific variation in DSR
S.Cubic_Time_habitat <-
list(formula = ~Time + Quadratic + Cubic + nest_hab)
# Cubic trend and interaction between habitat and managment on DSR
S.Cubic_Time_level_habitat <-
list(formula = ~Time + Quadratic + Cubic + level + nest_hab)
# interaction between habitat and management on DSR
S.status_habitat <-
list(formula = ~level + nest_hab)
# managment-specific variation in DSR
S.level<-
list(formula = ~level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level <-
list(formula = ~Time + Quadratic + Cubic + level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_m <-
list(formula = ~Time + Quadratic + Cubic + level + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_a <-
list(formula = ~Time + Quadratic + Cubic + level + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_m <-
list(formula = ~Time + Quadratic + Cubic + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_a <-
list(formula = ~Time + Quadratic + Cubic + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_m <-
list(formula = ~Time + Quadratic + Cubic + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_a <-
list(formula = ~Time + Quadratic + Cubic + level + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_m <-
list(formula = ~Time + Quadratic + Cubic + level + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_a <-
list(formula = ~Time + Quadratic + Cubic + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_a)
# Cubic seasonal trend and max. pred. birds
S.Cubic_Time_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + pbd_m)
# Cubic seasonal trend and average pred. birds
S.Cubic_Time_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + pbd_a)
# specify to run as a nest survival model in program MARK
cml <- RMark::create.model.list("Nest")
# run model list in MARK. Supress generation of MARK files.
model.list <- RMark::mark.wrapper(cml,
data = RMark_data_FP$nest_data.processed,
ddl = RMark_data_FP$nest_fate.ddl,
threads = 4,
brief = TRUE,
delete = TRUE)
# store completed model list
return(model.list)
}
nest_survival_run_FP <- nest_survival_FP()
nest_survival_run_FP
saveRDS(nest_survival_run_FP, file = "output/nest_survival_run_FP.rds")Mornington Peninsula model selection
Code
nest_survival_MP <- function()
{
# Specify models to test
# constant daily survival rate (DSR)
S.dot <-
list(formula = ~1)
# Linear trend in DSR
S.Time <-
list(formula = ~Time)
# Quadratic trend in DSR
S.Quadratic_Time <-
list(formula = ~Time + Quadratic)
# Cubic trend in DSR
S.Cubic_Time <-
list(formula = ~Time + Quadratic + Cubic)
# Linear trend in DSR
S.fundays <-
list(formula = ~fundays)
# Linear trend in DSR
S.fundays_level <-
list(formula = ~fundays + level)
#### average counts
# average humans detected
S.hum_a <-
list(formula = ~hum_a)
# average vehicles detected
S.veh_a <-
list(formula = ~veh_a)
# average dogs detected
S.dog_a <-
list(formula = ~dog_a)
# average dogs off leash detected
S.dof_a <-
list(formula = ~dof_a)
# average hoofed animals detected
S.hof_a <-
list(formula = ~hof_a)
# average hoofed animals detected
S.pbd_a <-
list(formula = ~pbd_a)
#### maximum counts
# max humans detected
S.hum_m <-
list(formula = ~hum_m)
# max vehicles detected
S.veh_m <-
list(formula = ~veh_m)
# max dogs detected
S.dog_m <-
list(formula = ~dog_m)
# max dogs off leash detected
S.dof_m <-
list(formula = ~dof_m)
# max predatory birds detected
S.pbd_m <-
list(formula = ~pbd_m)
#### interaction with management levels
# average humans detected
S.hum_a_level <-
list(formula = ~hum_a + level)
# average vehicles detected
S.veh_a_level <-
list(formula = ~veh_a + level)
# average dogs detected
S.dog_a_level <-
list(formula = ~dog_a + level)
# average dogs off leash detected
S.dof_a_level <-
list(formula = ~dof_a + level)
# average predatory birds detected
S.pbd_a_level <-
list(formula = ~pbd_a + level)
#### interaction with management levels
# max humans detected
S.hum_m_level <-
list(formula = ~hum_m+level)
# max vehicles detected
S.veh_m_level <-
list(formula = ~veh_m + level)
# max dogs detected
S.dog_m_level <-
list(formula = ~dog_m + level)
# max dogs off leash detected
S.dof_m_level <-
list(formula = ~dof_m + level)
# max predatory birds detected
S.pbd_m_level <-
list(formula = ~pbd_m + level)
# annual variation in DSR
S.season <-
list(formula = ~season)
# Cubic trend and annual variation DSR
S.Cubic_Time_season <-
list(formula = ~Time + Quadratic + Cubic + season)
# habitat-specific variation in DSR
S.habitat <-
list(formula = ~nest_hab)
# Cubic trend habitat-specific variation in DSR
S.Cubic_Time_habitat <-
list(formula = ~Time + Quadratic + Cubic + nest_hab)
# Cubic trend and interaction between habitat and managment on DSR
S.Cubic_Time_level_habitat <-
list(formula = ~Time + Quadratic + Cubic + level + nest_hab)
# interaction between habitat and management on DSR
S.status_habitat <-
list(formula = ~level + nest_hab)
# managment-specific variation in DSR
S.level<-
list(formula = ~level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level <-
list(formula = ~Time + Quadratic + Cubic + level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_m <-
list(formula = ~Time + Quadratic + Cubic + level + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_a <-
list(formula = ~Time + Quadratic + Cubic + level + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_m <-
list(formula = ~Time + Quadratic + Cubic + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_a <-
list(formula = ~Time + Quadratic + Cubic + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_m <-
list(formula = ~Time + Quadratic + Cubic + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_a <-
list(formula = ~Time + Quadratic + Cubic + level + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_m <-
list(formula = ~Time + Quadratic + Cubic + level + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_a <-
list(formula = ~Time + Quadratic + Cubic + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_a)
# Cubic seasonal trend and max. pred. birds
S.Cubic_Time_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + pbd_m)
# Cubic seasonal trend and average pred. birds
S.Cubic_Time_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + pbd_a)
# specify to run as a nest survival model in program MARK
cml <- RMark::create.model.list("Nest")
# run model list in MARK. Supress generation of MARK files.
model.list <- RMark::mark.wrapper(cml,
data = RMark_data_MP$nest_data.processed,
ddl = RMark_data_MP$nest_fate.ddl,
threads = 4,
brief = TRUE,
delete = TRUE)
# store completed model list
return(model.list)
}
nest_survival_run_MP <- nest_survival_MP()
nest_survival_run_MP
saveRDS(nest_survival_run_MP, file = "output/nest_survival_run_MP.rds")Bellarine / Surf Coast model selection
Code
nest_survival_BSC <- function()
{
# Specify models to test
# constant daily survival rate (DSR)
S.dot <-
list(formula = ~1)
# Linear trend in DSR
S.Time <-
list(formula = ~Time)
# Quadratic trend in DSR
S.Quadratic_Time <-
list(formula = ~Time + Quadratic)
# Cubic trend in DSR
S.Cubic_Time <-
list(formula = ~Time + Quadratic + Cubic)
# Linear trend in DSR
S.fundays <-
list(formula = ~fundays)
# Linear trend in DSR
S.fundays_level <-
list(formula = ~fundays + level)
#### average counts
# average humans detected
S.hum_a <-
list(formula = ~hum_a)
# average vehicles detected
S.veh_a <-
list(formula = ~veh_a)
# average dogs detected
S.dog_a <-
list(formula = ~dog_a)
# average dogs off leash detected
S.dof_a <-
list(formula = ~dof_a)
# average hoofed animals detected
S.hof_a <-
list(formula = ~hof_a)
# average hoofed animals detected
S.pbd_a <-
list(formula = ~pbd_a)
#### maximum counts
# max humans detected
S.hum_m <-
list(formula = ~hum_m)
# max vehicles detected
S.veh_m <-
list(formula = ~veh_m)
# max dogs detected
S.dog_m <-
list(formula = ~dog_m)
# max dogs off leash detected
S.dof_m <-
list(formula = ~dof_m)
# max predatory birds detected
S.pbd_m <-
list(formula = ~pbd_m)
#### interaction with management levels
# average humans detected
S.hum_a_level <-
list(formula = ~hum_a + level)
# average vehicles detected
S.veh_a_level <-
list(formula = ~veh_a + level)
# average dogs detected
S.dog_a_level <-
list(formula = ~dog_a + level)
# average dogs off leash detected
S.dof_a_level <-
list(formula = ~dof_a + level)
# average predatory birds detected
S.pbd_a_level <-
list(formula = ~pbd_a + level)
#### interaction with management levels
# max humans detected
S.hum_m_level <-
list(formula = ~hum_m+level)
# max vehicles detected
S.veh_m_level <-
list(formula = ~veh_m + level)
# max dogs detected
S.dog_m_level <-
list(formula = ~dog_m + level)
# max dogs off leash detected
S.dof_m_level <-
list(formula = ~dof_m + level)
# max predatory birds detected
S.pbd_m_level <-
list(formula = ~pbd_m + level)
# annual variation in DSR
S.season <-
list(formula = ~season)
# Cubic trend and annual variation DSR
S.Cubic_Time_season <-
list(formula = ~Time + Quadratic + Cubic + season)
# habitat-specific variation in DSR
S.habitat <-
list(formula = ~nest_hab)
# Cubic trend habitat-specific variation in DSR
S.Cubic_Time_habitat <-
list(formula = ~Time + Quadratic + Cubic + nest_hab)
# Cubic trend and interaction between habitat and managment on DSR
S.Cubic_Time_level_habitat <-
list(formula = ~Time + Quadratic + Cubic + level + nest_hab)
# interaction between habitat and management on DSR
S.status_habitat <-
list(formula = ~level + nest_hab)
# managment-specific variation in DSR
S.level<-
list(formula = ~level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level <-
list(formula = ~Time + Quadratic + Cubic + level)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_m <-
list(formula = ~Time + Quadratic + Cubic + level + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_hum_a <-
list(formula = ~Time + Quadratic + Cubic + level + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_m <-
list(formula = ~Time + Quadratic + Cubic + hum_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_hum_a <-
list(formula = ~Time + Quadratic + Cubic + hum_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_m <-
list(formula = ~Time + Quadratic + Cubic + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_a <-
list(formula = ~Time + Quadratic + Cubic + level + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_dog_m <-
list(formula = ~Time + Quadratic + Cubic + level + dog_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_dog_a <-
list(formula = ~Time + Quadratic + Cubic + dog_a)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_m)
# Cubic trend managment-specific variation in DSR
S.Cubic_Time_level_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + level + pbd_a)
# Cubic seasonal trend and max. pred. birds
S.Cubic_Time_pbd_m <-
list(formula = ~Time + Quadratic + Cubic + pbd_m)
# Cubic seasonal trend and average pred. birds
S.Cubic_Time_pbd_a <-
list(formula = ~Time + Quadratic + Cubic + pbd_a)
# specify to run as a nest survival model in program MARK
cml <- RMark::create.model.list("Nest")
# run model list in MARK. Supress generation of MARK files.
model.list <- RMark::mark.wrapper(cml,
data = RMark_data_BSC$nest_data.processed,
ddl = RMark_data_BSC$nest_fate.ddl,
threads = 4,
brief = TRUE,
delete = TRUE)
# store completed model list
return(model.list)
}
nest_survival_run_BSC <- nest_survival_BSC()
nest_survival_run_BSC
saveRDS(nest_survival_run_BSC, file = "output/nest_survival_run_BSC.rds")Fleurieu Peninsula: Visualize results
Code
nest_survival_run_FP <- readRDS(file = "output/nest_survival_run_FP.rds")
nest_survival_run_FP model npar AICc DeltaAICc
28 S(~fundays + level) 6 1605.720 0.000000
27 S(~fundays) 2 1611.158 5.438115
23 S(~dog_a + level) 6 1638.688 32.967800
32 S(~hum_a + level) 6 1639.052 33.331700
8 S(~Time + Quadratic + Cubic + level + dog_a) 9 1640.953 35.232326
45 S(~veh_a + level) 6 1641.372 35.652000
19 S(~dof_a + level) 6 1641.593 35.872700
11 S(~Time + Quadratic + Cubic + level + hum_a) 9 1641.881 36.161026
35 S(~level) 5 1642.781 37.061070
47 S(~veh_m + level) 6 1642.789 37.068900
34 S(~hum_m + level) 6 1643.541 37.820800
37 S(~pbd_a + level) 6 1643.818 38.097300
25 S(~dog_m + level) 6 1644.604 38.883400
42 S(~level + nest_hab) 7 1644.605 38.884986
39 S(~pbd_m + level) 6 1644.614 38.893300
21 S(~dof_m + level) 6 1644.774 39.053500
7 S(~Time + Quadratic + Cubic + level) 8 1645.414 39.693628
12 S(~Time + Quadratic + Cubic + level + hum_m) 9 1646.042 40.321826
13 S(~Time + Quadratic + Cubic + level + pbd_a) 9 1646.396 40.676126
9 S(~Time + Quadratic + Cubic + level + dog_m) 9 1647.104 41.383526
14 S(~Time + Quadratic + Cubic + level + pbd_m) 9 1647.292 41.572126
10 S(~Time + Quadratic + Cubic + level + nest_hab) 10 1647.473 41.752482
22 S(~dog_a) 2 1675.740 70.020215
2 S(~Time + Quadratic + Cubic + dog_a) 5 1678.399 72.679170
31 S(~hum_a) 2 1679.628 73.907815
5 S(~Time + Quadratic + Cubic + hum_a) 5 1682.107 76.386870
18 S(~dof_a) 2 1683.316 77.595415
44 S(~veh_a) 2 1687.810 82.089315
30 S(~hof_a) 2 1688.142 82.421515
36 S(~pbd_a) 2 1688.733 83.012515
33 S(~hum_m) 2 1689.051 83.330815
24 S(~dog_m) 2 1689.324 83.603715
46 S(~veh_m) 2 1689.816 84.095715
41 S(~season) 12 1690.264 84.543766
15 S(~Time + Quadratic + Cubic + pbd_a) 5 1690.318 84.597370
6 S(~Time + Quadratic + Cubic + hum_m) 5 1690.860 85.139570
26 S(~1) 1 1691.000 85.280206
3 S(~Time + Quadratic + Cubic + dog_m) 5 1691.336 85.615670
20 S(~dof_m) 2 1691.480 85.759515
29 S(~nest_hab) 3 1691.953 86.232478
40 S(~Time + Quadratic) 3 1692.246 86.525978
38 S(~pbd_m) 2 1692.613 86.893015
17 S(~Time + Quadratic + Cubic + season) 15 1692.638 86.917428
1 S(~Time + Quadratic + Cubic) 4 1692.758 87.037397
43 S(~Time) 2 1692.940 87.219515
4 S(~Time + Quadratic + Cubic + nest_hab) 6 1693.460 87.739600
16 S(~Time + Quadratic + Cubic + pbd_m) 5 1694.305 88.584270
weight Deviance
28 9.381416e-01 1593.707
27 6.185813e-02 1607.156
23 6.507312e-08 1626.674
32 5.424775e-08 1627.038
8 2.097326e-08 1622.923
45 1.700337e-08 1629.359
19 1.522687e-08 1629.579
11 1.318261e-08 1623.852
35 8.405416e-09 1632.772
47 8.372575e-09 1630.775
34 5.748917e-09 1631.527
37 5.006622e-09 1631.804
25 3.379445e-09 1632.590
42 3.376767e-09 1630.587
39 3.362758e-09 1632.600
21 3.103907e-09 1632.760
7 2.253755e-09 1629.390
12 1.646247e-09 1628.013
13 1.378986e-09 1628.367
9 9.681660e-10 1629.074
14 8.810405e-10 1629.263
10 8.050671e-10 1627.437
22 0.000000e+00 1671.738
2 0.000000e+00 1668.390
31 0.000000e+00 1675.626
5 0.000000e+00 1672.097
18 0.000000e+00 1679.314
44 0.000000e+00 1683.808
30 0.000000e+00 1684.140
36 0.000000e+00 1684.731
33 0.000000e+00 1685.049
24 0.000000e+00 1685.322
46 0.000000e+00 1685.814
41 0.000000e+00 1666.213
15 0.000000e+00 1680.308
6 0.000000e+00 1680.850
26 0.000000e+00 1689.000
3 0.000000e+00 1681.326
20 0.000000e+00 1687.478
29 0.000000e+00 1685.949
40 0.000000e+00 1686.242
38 0.000000e+00 1688.611
17 0.000000e+00 1662.559
1 0.000000e+00 1684.751
43 0.000000e+00 1688.938
4 0.000000e+00 1681.446
16 0.000000e+00 1684.295Code
S.fundays_level <- nest_survival_run_FP[[28]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays+level)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.fundays_level$results$beta estimate se lcl ucl
S:(Intercept) 2.9507538 0.1791678 2.5995850 3.3019227
S:fundays -0.1787035 0.0285274 -0.2346172 -0.1227899
S:levelL1 0.1875748 0.2695756 -0.3407935 0.7159430
S:levelL2 0.1907330 0.3476289 -0.4906197 0.8720856
S:levelL3 0.5935509 0.1769868 0.2466568 0.9404450
S:levelL4 1.1648247 0.5301658 0.1256997 2.2039496Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_FP$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_FP$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_FP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.fundays_level <-
covariate.predictions(model = S.fundays_level,
data = data.frame(fundays = fundays.values),
indices = level_indices)
# store values of Level in pred.top
L0.rows <- which(pred.fundays_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.fundays_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.fundays_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.fundays_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.fundays_level$estimates$par.index == level_indices[5])
pred.fundays_level$estimates$level <- NA
pred.fundays_level$estimates$level[L0.rows] <- "L0"
pred.fundays_level$estimates$level[L1.rows] <- "L1"
pred.fundays_level$estimates$level[L2.rows] <- "L2"
pred.fundays_level$estimates$level[L3.rows] <- "L3"
pred.fundays_level$estimates$level[L4.rows] <- "L4"
head(pred.fundays_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.9502991 0.008462222 0.9308353
2 2 2 17813 0.0000000 0.9584464 0.010584289 0.9319765
3 3 3 24401 0.0000000 0.9585720 0.012760447 0.9249578
4 4 4 28305 0.0000000 0.9719224 0.002322382 0.9669941
5 5 5 71737 0.0000000 0.9839455 0.007989799 0.9578823
6 6 1 1 0.2121212 0.9484779 0.008563477 0.9288651
ucl fixed level
1 0.9644945 L0
2 0.9748935 L1
3 0.9774954 L2
4 0.9761330 L3
5 0.9939816 L4
6 0.9628991 L0Code
# build and store the plot in object 'p'
fundays_level_nest_survival_plot <-
ggplot(pred.fundays_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 5, 10)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0.5, 1)) +
ggtitle("Fleurieu Peninsula")
fundays_level_nest_survival_plot
Code
#### effect of fundays
S.fundays <- nest_survival_run_FP[[27]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.fundays$results$beta estimate se lcl ucl
S:(Intercept) 3.5114199 0.0811390 3.352387 3.6704522
S:fundays -0.2318867 0.0243726 -0.279657 -0.1841163Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_FP$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_FP$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
pred.fundays <-
covariate.predictions(model = S.fundays,
data = data.frame(fundays = fundays.values),
indices = 1)
fundays_nest_survival_plot <-
ggplot(pred.fundays$estimates,
aes(x = covdata, y = estimate)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 5, 10)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0.5, 1)) +
ggtitle("Fleurieu Peninsula")
fundays_nest_survival_plot
Code
#### effect of predatory birds and level
S.pbd_m_level <- nest_survival_run_FP[[39]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~pbd_m + level)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.pbd_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.2976958000 0.1257213 2.0512821 2.5441096
S:pbd_m -0.0005475619 0.0012967 -0.0030890 0.0019939
S:levelL1 0.1838475000 0.2583147 -0.3224494 0.6901444
S:levelL2 0.5045569000 0.3365104 -0.1550035 1.1641173
S:levelL3 1.0644501000 0.1499949 0.7704601 1.3584401
S:levelL4 1.6477687000 0.5202835 0.6280131 2.6675243Code
# create values of pbd_a to use for predictions
min.pbd_m = min(RMark_data_FP$nest_data.processed$data$pbd_m)
max.pbd_m = max(RMark_data_FP$nest_data.processed$data$pbd_m)
pbd_m.values = seq(from = min.pbd_m, to = max.pbd_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_FP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.pbd_m_level <-
covariate.predictions(model = S.pbd_m_level,
data = data.frame(pbd_m = pbd_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[5])
pred.pbd_m_level$estimates$level <- NA
pred.pbd_m_level$estimates$level[L0.rows] <- "L0"
pred.pbd_m_level$estimates$level[L1.rows] <- "L1"
pred.pbd_m_level$estimates$level[L2.rows] <- "L2"
pred.pbd_m_level$estimates$level[L3.rows] <- "L3"
pred.pbd_m_level$estimates$level[L4.rows] <- "L4"
head(pred.pbd_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.000000 0.9086860 0.010431814 0.8860776
2 2 2 17813 0.000000 0.9228377 0.016089111 0.8848008
3 3 3 24401 0.000000 0.9427975 0.016836945 0.8993802
4 4 4 28305 0.000000 0.9665003 0.002707559 0.9607681
5 5 5 71737 0.000000 0.9810248 0.009399850 0.9505353
6 6 1 1 1.337793 0.9086252 0.010433518 0.8860144
ucl fixed level
1 0.9271765 L0
2 0.9490388 L1
3 0.9681438 L2
4 0.9714199 L3
5 0.9928620 L4
6 0.9271197 L0Code
# build and store the plot in object 'p'
pbd_m_level_nest_survival_plot <-
ggplot(pred.pbd_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 200, 400)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of predatory birds counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Fleurieu Peninsula")
pbd_m_level_nest_survival_plot
Code
#### effect of humans and level
S.hum_m_level <- nest_survival_run_FP[[34]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~hum_m + level)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.hum_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.2907932 0.1257543 2.0443147 2.5372716
S:hum_m 0.0023409 0.0026154 -0.0027853 0.0074670
S:levelL1 0.1791990 0.2581866 -0.3268468 0.6852448
S:levelL2 0.4921208 0.3368460 -0.1680973 1.1523388
S:levelL3 1.0352958 0.1486473 0.7439470 1.3266446
S:levelL4 1.6173624 0.5211692 0.5958707 2.6388542Code
# create values of pbd_m to use for predictions
min.hum_m = min(RMark_data_FP$nest_data.processed$data$hum_m)
max.hum_m = max(RMark_data_FP$nest_data.processed$data$hum_m)
hum_m.values = seq(from = min.hum_m, to = max.hum_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_FP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.hum_m_level <-
covariate.predictions(model = S.hum_m_level,
data = data.frame(hum_m = hum_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[5])
pred.hum_m_level$estimates$level <- NA
pred.hum_m_level$estimates$level[L0.rows] <- "L0"
pred.hum_m_level$estimates$level[L1.rows] <- "L1"
pred.hum_m_level$estimates$level[L2.rows] <- "L2"
pred.hum_m_level$estimates$level[L3.rows] <- "L3"
pred.hum_m_level$estimates$level[L4.rows] <- "L4"
head(pred.hum_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.000000 0.9081116 0.010493554 0.8853724
2 2 2 17813 0.000000 0.9220112 0.016225527 0.8836781
3 3 3 24401 0.000000 0.9417455 0.017162242 0.8975022
4 4 4 28305 0.000000 0.9653131 0.002703940 0.9596050
5 5 5 71737 0.000000 0.9803177 0.009766167 0.9486374
6 6 1 1 2.468227 0.9085927 0.010434925 0.8859794
ucl fixed level
1 0.9267134 L0
2 0.9484488 L1
3 0.9675810 L2
4 0.9702396 L3
5 0.9926099 L4
6 0.9270901 L0Code
# build and store the plot in object 'p'
hum_m_level_nest_survival_plot <-
ggplot(pred.hum_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 100, 200), limits = c(0, 100)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of humans counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Fleurieu Peninsula")
hum_m_level_nest_survival_plot
Code
#### effect of dogs and level
S.dog_m_level <- nest_survival_run_FP[[25]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dog_m + level)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.dog_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.2937880 0.1257076 2.0474011 2.5401748
S:dog_m 0.0061681 0.0150659 -0.0233610 0.0356973
S:levelL1 0.1804117 0.2581805 -0.3256221 0.6864455
S:levelL2 0.4933371 0.3377482 -0.1686494 1.1553237
S:levelL3 1.0408666 0.1507977 0.7453032 1.3364300
S:levelL4 1.6315212 0.5214098 0.6095580 2.6534845Code
# create values of pbd_m to use for predictions
min.dog_m = min(RMark_data_FP$nest_data.processed$data$dog_m)
max.dog_m = max(RMark_data_FP$nest_data.processed$data$dog_m)
dog_m.values = seq(from = min.dog_m, to = max.dog_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_FP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dog_m_level <-
covariate.predictions(model = S.dog_m_level,
data = data.frame(dog_m = dog_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[5])
pred.dog_m_level$estimates$level <- NA
pred.dog_m_level$estimates$level[L0.rows] <- "L0"
pred.dog_m_level$estimates$level[L1.rows] <- "L1"
pred.dog_m_level$estimates$level[L2.rows] <- "L2"
pred.dog_m_level$estimates$level[L3.rows] <- "L3"
pred.dog_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dog_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.9083613 0.010464036 0.8856852
2 2 2 17813 0.0000000 0.9223132 0.016164069 0.8841208
3 3 3 24401 0.0000000 0.9419761 0.017160276 0.8976857
4 4 4 28305 0.0000000 0.9655987 0.002829462 0.9596008
5 5 5 71737 0.0000000 0.9806459 0.009610827 0.9494454
6 6 1 1 0.2240803 0.9084762 0.010445868 0.8858402
ucl fixed level
1 0.9269103 L0
2 0.9486489 L1
3 0.9677820 L2
4 0.9707333 L3
5 0.9927379 L4
6 0.9269938 L0Code
# build and store the plot in object 'p'
dog_m_level_nest_survival_plot <-
ggplot(pred.dog_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20), limits = c(0, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max .number of dogs counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Fleurieu Peninsula")
dog_m_level_nest_survival_plot
Code
#### effect of dofs and level
S.dof_m_level <- nest_survival_run_FP[[21]]
# mark(data = RMark_data_FP$nest_data.processed,
# ddl = RMark_data_FP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dof_m + level)),
# nocc = occ_FP,
# brief = TRUE,
# delete = TRUE)
S.dof_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.2960637 0.1256705 2.0497495 2.5423779
S:dof_m -0.0023890 0.0220740 -0.0456540 0.0408759
S:levelL1 0.1800837 0.2581752 -0.3259398 0.6861072
S:levelL2 0.5087306 0.3381538 -0.1540508 1.1715121
S:levelL3 1.0571361 0.1508433 0.7614833 1.3527889
S:levelL4 1.6472363 0.5204329 0.6271878 2.6672848Code
# create values of pbd_m to use for predictions
min.dof_m = min(RMark_data_FP$nest_data.processed$data$dof_m)
max.dof_m = max(RMark_data_FP$nest_data.processed$data$dof_m)
dof_m.values = seq(from = min.dof_m, to = max.dof_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_FP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dof_m_level <-
covariate.predictions(model = S.dof_m_level,
data = data.frame(dof_m = dof_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[5])
pred.dof_m_level$estimates$level <- NA
pred.dof_m_level$estimates$level[L0.rows] <- "L0"
pred.dof_m_level$estimates$level[L1.rows] <- "L1"
pred.dof_m_level$estimates$level[L2.rows] <- "L2"
pred.dof_m_level$estimates$level[L3.rows] <- "L3"
pred.dof_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dof_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.9085505 0.010441518 0.8859228
2 2 2 17813 0.0000000 0.9224526 0.016135434 0.8843261
3 3 3 24401 0.0000000 0.9429343 0.016916471 0.8992232
4 4 4 28305 0.0000000 0.9662095 0.002774107 0.9603294
5 5 5 71737 0.0000000 0.9809845 0.009423226 0.9504147
6 6 1 1 0.1170569 0.9085273 0.010439705 0.8859045
ucl fixed level
1 0.9270595 L0
2 0.9487410 L1
3 0.9683534 L2
4 0.9712441 L3
5 0.9928495 L4
6 0.9270339 L0Code
# build and store the plot in object 'p'
dof_m_level_nest_survival_plot <-
ggplot(pred.dof_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20), limits = c(0, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of dogs off leash counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Fleurieu Peninsula")
dof_m_level_nest_survival_plot
Mornington Peninsula: Visualize results
Code
nest_survival_run_MP <- readRDS(file = "output/nest_survival_run_MP.rds")
nest_survival_run_MP model npar AICc DeltaAICc
27 S(~fundays) 2 2154.879 0.000000
28 S(~fundays + level) 6 2161.273 6.394889
7 S(~Time + Quadratic + Cubic + level) 8 2292.489 137.610750
12 S(~Time + Quadratic + Cubic + level + hum_m) 9 2292.692 137.813947
13 S(~Time + Quadratic + Cubic + level + pbd_a) 9 2293.052 138.173947
9 S(~Time + Quadratic + Cubic + level + dog_m) 9 2293.692 138.813147
11 S(~Time + Quadratic + Cubic + level + hum_a) 9 2294.074 139.195047
10 S(~Time + Quadratic + Cubic + level + nest_hab) 11 2294.228 139.348976
35 S(~level) 5 2294.306 139.427325
8 S(~Time + Quadratic + Cubic + level + dog_a) 9 2294.331 139.452347
14 S(~Time + Quadratic + Cubic + level + pbd_m) 9 2294.475 139.596347
34 S(~hum_m + level) 6 2294.669 139.790089
21 S(~dof_m + level) 6 2294.729 139.850089
37 S(~pbd_a + level) 6 2294.788 139.909589
19 S(~dof_a + level) 6 2295.019 140.139989
1 S(~Time + Quadratic + Cubic) 4 2295.279 140.400706
15 S(~Time + Quadratic + Cubic + pbd_a) 5 2295.383 140.504525
25 S(~dog_m + level) 6 2295.509 140.630889
45 S(~veh_a + level) 6 2295.547 140.668889
42 S(~level + nest_hab) 8 2295.652 140.773250
6 S(~Time + Quadratic + Cubic + hum_m) 5 2295.672 140.793825
20 S(~dof_m) 2 2295.772 140.893200
26 S(~1) 1 2295.934 141.055013
36 S(~pbd_a) 2 2295.957 141.078100
32 S(~hum_a + level) 6 2295.977 141.098089
30 S(~hof_a) 2 2296.024 141.145800
4 S(~Time + Quadratic + Cubic + nest_hab) 7 2296.130 141.251197
23 S(~dog_a + level) 6 2296.173 141.294089
18 S(~dof_a) 2 2296.241 141.362200
47 S(~veh_m + level) 6 2296.258 141.378989
3 S(~Time + Quadratic + Cubic + dog_m) 5 2296.299 141.420125
39 S(~pbd_m + level) 6 2296.300 141.421489
33 S(~hum_m) 2 2296.571 141.692800
29 S(~nest_hab) 4 2296.687 141.808606
5 S(~Time + Quadratic + Cubic + hum_a) 5 2296.987 142.108625
24 S(~dog_m) 2 2297.064 142.185600
2 S(~Time + Quadratic + Cubic + dog_a) 5 2297.090 142.211225
43 S(~Time) 2 2297.104 142.225700
16 S(~Time + Quadratic + Cubic + pbd_m) 5 2297.280 142.401725
44 S(~veh_a) 2 2297.404 142.525200
31 S(~hum_a) 2 2297.756 142.877200
22 S(~dog_a) 2 2297.802 142.923900
46 S(~veh_m) 2 2297.904 143.025700
38 S(~pbd_m) 2 2297.928 143.049800
40 S(~Time + Quadratic) 3 2299.080 144.201431
17 S(~Time + Quadratic + Cubic + season) 18 2311.247 156.368361
41 S(~season) 15 2314.657 159.778479
weight Deviance
27 0.960738 2150.877
28 0.039262 2149.264
7 0.000000 2276.473
12 0.000000 2274.673
13 0.000000 2275.032
9 0.000000 2275.672
11 0.000000 2276.054
10 0.000000 2272.198
35 0.000000 2284.299
8 0.000000 2276.311
14 0.000000 2276.455
34 0.000000 2282.659
21 0.000000 2282.719
37 0.000000 2282.779
19 0.000000 2283.009
1 0.000000 2287.275
15 0.000000 2285.376
25 0.000000 2283.500
45 0.000000 2283.538
42 0.000000 2279.636
6 0.000000 2285.666
20 0.000000 2291.770
26 0.000000 2293.933
36 0.000000 2291.955
32 0.000000 2283.967
30 0.000000 2292.023
4 0.000000 2282.117
23 0.000000 2284.163
18 0.000000 2292.239
47 0.000000 2284.248
3 0.000000 2286.292
39 0.000000 2284.291
33 0.000000 2292.570
29 0.000000 2288.683
5 0.000000 2286.981
24 0.000000 2293.063
2 0.000000 2287.083
43 0.000000 2293.103
16 0.000000 2287.274
44 0.000000 2293.402
31 0.000000 2293.754
22 0.000000 2293.801
46 0.000000 2293.903
38 0.000000 2293.927
40 0.000000 2293.077
17 0.000000 2275.171
41 0.000000 2284.604Code
S.fundays_level <- nest_survival_run_MP[[28]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays+level)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.fundays_level$results$beta estimate se lcl ucl
S:(Intercept) 3.6380976 0.1500632 3.3439736 3.9322215
S:fundays -0.3001217 0.0263130 -0.3516953 -0.2485482
S:levelL1 0.0314436 0.2235930 -0.4067986 0.4696859
S:levelL2 0.2572399 0.2100025 -0.1543651 0.6688448
S:levelL3 0.0839720 0.1405138 -0.1914350 0.3593790
S:levelL4 0.0624976 1.0259887 -1.9484403 2.0734354Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_MP$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_MP$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_MP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.fundays_level <-
covariate.predictions(model = S.fundays_level,
data = data.frame(fundays = fundays.values),
indices = level_indices)
# store values of Level in pred.top
L0.rows <- which(pred.fundays_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.fundays_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.fundays_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.fundays_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.fundays_level$estimates$par.index == level_indices[5])
pred.fundays_level$estimates$level <- NA
pred.fundays_level$estimates$level[L0.rows] <- "L0"
pred.fundays_level$estimates$level[L1.rows] <- "L1"
pred.fundays_level$estimates$level[L2.rows] <- "L2"
pred.fundays_level$estimates$level[L3.rows] <- "L3"
pred.fundays_level$estimates$level[L4.rows] <- "L4"
head(pred.fundays_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.9743717 0.003747296 0.9659071
2 2 2 23809 0.0000000 0.9751453 0.004915066 0.9634583
3 3 3 35217 0.0000000 0.9800688 0.003632967 0.9715520
4 4 4 49601 0.0000000 0.9763872 0.001939384 0.9722722
5 5 5 121521 0.0000000 0.9758870 0.023937616 0.8464223
6 6 1 1 0.2727273 0.9722465 0.003937666 0.9633932
ucl fixed level
1 0.9807766 L0
2 0.9831599 L1
3 0.9860724 L2
4 0.9799041 L3
5 0.9966465 L4
6 0.9790052 L0Code
# build and store the plot in object 'p'
fundays_level_nest_survival_plot <-
ggplot(pred.fundays_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 5, 10, 15, 20, 25)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0, 1)) +
ggtitle("Morninton Peninsula")
fundays_level_nest_survival_plot
Code
#### effect of fundays
S.fundays <- nest_survival_run_MP[[27]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.fundays$results$beta estimate se lcl ucl
S:(Intercept) 3.7268898 0.0807578 3.5686044 3.8851751
S:fundays -0.3028434 0.0254822 -0.3527884 -0.2528983Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_MP$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_MP$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
pred.fundays <-
covariate.predictions(model = S.fundays,
data = data.frame(fundays = fundays.values),
indices = 1)
fundays_nest_survival_plot <-
ggplot(pred.fundays$estimates,
aes(x = covdata, y = estimate)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 5, 10, 15)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0, 1)) +
ggtitle("Morninton Peninsula")
fundays_nest_survival_plot
Code
#### effect of predatory birds and level
S.pbd_m_level <- nest_survival_run_MP[[39]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~pbd_m + level)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.pbd_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.788768600 0.1138521 2.5656184 3.0119188
S:pbd_m -0.000281891 0.0030341 -0.0062287 0.0056649
S:levelL1 0.148089000 0.2126726 -0.2687492 0.5649273
S:levelL2 0.406021600 0.1966011 0.0206834 0.7913598
S:levelL3 0.387677800 0.1297664 0.1333356 0.6420200
S:levelL4 0.611697100 1.0232642 -1.3939008 2.6172950Code
# create values of pbd_a to use for predictions
min.pbd_m = min(RMark_data_MP$nest_data.processed$data$pbd_m)
max.pbd_m = max(RMark_data_MP$nest_data.processed$data$pbd_m)
pbd_m.values = seq(from = min.pbd_m, to = max.pbd_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_MP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.pbd_m_level <-
covariate.predictions(model = S.pbd_m_level,
data = data.frame(pbd_m = pbd_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[5])
pred.pbd_m_level$estimates$level <- NA
pred.pbd_m_level$estimates$level[L0.rows] <- "L0"
pred.pbd_m_level$estimates$level[L1.rows] <- "L1"
pred.pbd_m_level$estimates$level[L2.rows] <- "L2"
pred.pbd_m_level$estimates$level[L3.rows] <- "L3"
pred.pbd_m_level$estimates$level[L4.rows] <- "L4"
head(pred.pbd_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.9420659 0.006213793 0.9286161
2 2 2 23809 0.0000000 0.9496387 0.008604134 0.9298406
3 3 3 35217 0.0000000 0.9606377 0.006074285 0.9468459
4 4 4 49601 0.0000000 0.9599382 0.002460817 0.9548270
5 5 5 121521 0.0000000 0.9677191 0.031767114 0.8033488
6 6 1 1 0.8662207 0.9420525 0.006207804 0.9286173
ucl fixed level
1 0.9531095 L0
2 0.9640659 L1
3 0.9709608 L2
4 0.9644927 L3
5 0.9954749 L4
6 0.9530868 L0Code
# build and store the plot in object 'p'
pbd_m_level_nest_survival_plot <-
ggplot(pred.pbd_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 100, 200)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of predatory birds counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Morninton Peninsula")
pbd_m_level_nest_survival_plot
Code
#### effect of humans and level
S.hum_m_level <- nest_survival_run_MP[[34]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~hum_m + level)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.hum_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.7950360 0.1137244 2.5721363 3.0179358000
S:hum_m -0.0018216 0.0012297 -0.0042319 0.0005885835
S:levelL1 0.1436986 0.2126954 -0.2731845 0.5605817000
S:levelL2 0.4114739 0.1966371 0.0260652 0.7968826000
S:levelL3 0.3919019 0.1296035 0.1378791 0.6459247000
S:levelL4 0.6054301 1.0232397 -1.4001198 2.6109799000Code
# create values of pbd_m to use for predictions
min.hum_m = min(RMark_data_MP$nest_data.processed$data$hum_m)
max.hum_m = max(RMark_data_MP$nest_data.processed$data$hum_m)
hum_m.values = seq(from = min.hum_m, to = max.hum_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_MP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.hum_m_level <-
covariate.predictions(model = S.hum_m_level,
data = data.frame(hum_m = hum_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[5])
pred.hum_m_level$estimates$level <- NA
pred.hum_m_level$estimates$level[L0.rows] <- "L0"
pred.hum_m_level$estimates$level[L1.rows] <- "L1"
pred.hum_m_level$estimates$level[L2.rows] <- "L2"
pred.hum_m_level$estimates$level[L3.rows] <- "L3"
pred.hum_m_level$estimates$level[L4.rows] <- "L4"
head(pred.hum_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.000000 0.9424070 0.006172510 0.9290469
2 2 2 23809 0.000000 0.9497284 0.008583701 0.9299788
3 3 3 35217 0.000000 0.9610785 0.006010487 0.9474288
4 4 4 49601 0.000000 0.9603398 0.002395362 0.9553692
5 5 5 121521 0.000000 0.9677191 0.031766798 0.8033520
6 6 1 1 2.725753 0.9421369 0.006194701 0.9287308
ucl fixed level
1 0.9533777 L0
2 0.9641224 L1
3 0.9712916 L2
4 0.9647772 L3
5 0.9954748 L4
6 0.9531485 L0Code
# build and store the plot in object 'p'
hum_m_level_nest_survival_plot <-
ggplot(pred.hum_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 100, 200), limits = c(0, 100)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of humans counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Morninton Peninsula")
hum_m_level_nest_survival_plot
Code
#### effect of dogs and level
S.dog_m_level <- nest_survival_run_MP[[25]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dog_m + level)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.dog_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.7995525 0.1144144 2.5753003 3.0238047
S:dog_m -0.0384695 0.0411625 -0.1191480 0.0422089
S:levelL1 0.1420235 0.2128212 -0.2751062 0.5591531
S:levelL2 0.3971873 0.1968707 0.0113208 0.7830539
S:levelL3 0.3857290 0.1295172 0.1318752 0.6395827
S:levelL4 0.6009158 1.0233251 -1.4048015 2.6066331Code
# create values of pbd_m to use for predictions
min.dog_m = min(RMark_data_MP$nest_data.processed$data$dog_m)
max.dog_m = max(RMark_data_MP$nest_data.processed$data$dog_m)
dog_m.values = seq(from = min.dog_m, to = max.dog_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_MP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dog_m_level <-
covariate.predictions(model = S.dog_m_level,
data = data.frame(dog_m = dog_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[5])
pred.dog_m_level$estimates$level <- NA
pred.dog_m_level$estimates$level[L0.rows] <- "L0"
pred.dog_m_level$estimates$level[L1.rows] <- "L1"
pred.dog_m_level$estimates$level[L2.rows] <- "L2"
pred.dog_m_level$estimates$level[L3.rows] <- "L3"
pred.dog_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dog_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.00000000 0.9426516 0.006185191 0.9292552
2 2 2 23809 0.00000000 0.9498638 0.008567008 0.9301496
3 3 3 35217 0.00000000 0.9607114 0.006056528 0.9469618
4 4 4 49601 0.00000000 0.9602766 0.002414267 0.9552650
5 5 5 121521 0.00000000 0.9677192 0.031767000 0.8033498
6 6 1 1 0.04347826 0.9425612 0.006183699 0.9291706
ucl fixed level
1 0.9536379 L0
2 0.9642280 L1
3 0.9710057 L2
4 0.9647475 L3
5 0.9954749 L4
6 0.9535467 L0Code
# build and store the plot in object 'p'
dog_m_level_nest_survival_plot <-
ggplot(pred.dog_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max .number of dogs counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Morninton Peninsula")
dog_m_level_nest_survival_plot
Code
#### effect of dofs and level
S.dof_m_level <- nest_survival_run_MP[[21]]
# mark(data = RMark_data_MP$nest_data.processed,
# ddl = RMark_data_MP$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dof_m + level)),
# nocc = occ_MP,
# brief = TRUE,
# delete = TRUE)
S.dof_m_level$results$beta estimate se lcl ucl
S:(Intercept) 2.8107055 0.1154273 2.5844679000 3.0369431
S:dof_m -0.0716748 0.0539243 -0.1773665000 0.0340168
S:levelL1 0.1310871 0.2133016 -0.2869841000 0.5491583
S:levelL2 0.3864629 0.1974023 -0.0004456941 0.7733715
S:levelL3 0.3747481 0.1300333 0.1198829000 0.6296134
S:levelL4 0.5897668 1.0234399 -1.4161755000 2.5957090Code
# create values of pbd_m to use for predictions
min.dof_m = min(RMark_data_MP$nest_data.processed$data$dof_m)
max.dof_m = max(RMark_data_MP$nest_data.processed$data$dof_m)
dof_m.values = seq(from = min.dof_m, to = max.dof_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_MP$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dof_m_level <-
covariate.predictions(model = S.dof_m_level,
data = data.frame(dof_m = dof_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[5])
pred.dof_m_level$estimates$level <- NA
pred.dof_m_level$estimates$level[L0.rows] <- "L0"
pred.dof_m_level$estimates$level[L1.rows] <- "L1"
pred.dof_m_level$estimates$level[L2.rows] <- "L2"
pred.dof_m_level$estimates$level[L3.rows] <- "L3"
pred.dof_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dof_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.00000000 0.9432516 0.006178595 0.9298555
2 2 2 23809 0.00000000 0.9498742 0.008564413 0.9301662
3 3 3 35217 0.00000000 0.9607276 0.006053889 0.9469839
4 4 4 49601 0.00000000 0.9602832 0.002393756 0.9553166
5 5 5 121521 0.00000000 0.9677193 0.031766913 0.8033501
6 6 1 1 0.03010033 0.9431360 0.006175720 0.9297498
ucl fixed level
1 0.9542153 L0
2 0.9642341 L1
3 0.9710174 L2
4 0.9647182 L3
5 0.9954749 L4
6 0.9540974 L0Code
# build and store the plot in object 'p'
dof_m_level_nest_survival_plot <-
ggplot(pred.dof_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of dogs off leash counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Morninton Peninsula")
dof_m_level_nest_survival_plot
Bellarine / Surf Coast: Visualize results
Code
nest_survival_run_BSC <- readRDS(file = "output/nest_survival_run_BSC.rds")
nest_survival_run_BSC model npar AICc DeltaAICc
28 S(~fundays + level) 6 1244.113 0.00000
10 S(~Time + Quadratic + Cubic + level + nest_hab) 10 1269.338 25.22534
11 S(~Time + Quadratic + Cubic + level + hum_a) 9 1269.758 25.64531
32 S(~hum_a + level) 6 1270.291 26.17840
7 S(~Time + Quadratic + Cubic + level) 8 1272.064 27.95183
8 S(~Time + Quadratic + Cubic + level + dog_a) 9 1272.199 28.08641
12 S(~Time + Quadratic + Cubic + level + hum_m) 9 1272.302 28.18941
23 S(~dog_a + level) 6 1273.157 29.04480
42 S(~level + nest_hab) 7 1273.550 29.43779
34 S(~hum_m + level) 6 1273.772 29.65890
13 S(~Time + Quadratic + Cubic + level + pbd_a) 9 1273.886 29.77381
14 S(~Time + Quadratic + Cubic + level + pbd_m) 9 1274.038 29.92531
9 S(~Time + Quadratic + Cubic + level + dog_m) 9 1274.071 29.95851
45 S(~veh_a + level) 6 1274.091 29.97880
47 S(~veh_m + level) 6 1275.151 31.03840
19 S(~dof_a + level) 6 1275.275 31.16220
21 S(~dof_m + level) 6 1275.956 31.84340
25 S(~dog_m + level) 6 1276.347 32.23390
27 S(~fundays) 2 1278.800 34.68716
5 S(~Time + Quadratic + Cubic + hum_a) 5 1307.999 63.88605
2 S(~Time + Quadratic + Cubic + dog_a) 5 1310.261 66.14855
1 S(~Time + Quadratic + Cubic) 4 1310.449 66.33585
6 S(~Time + Quadratic + Cubic + hum_m) 5 1310.651 66.53785
40 S(~Time + Quadratic) 3 1311.764 67.65148
4 S(~Time + Quadratic + Cubic + nest_hab) 6 1312.242 68.12940
43 S(~Time) 2 1312.303 68.19006
16 S(~Time + Quadratic + Cubic + pbd_m) 5 1312.351 68.23805
15 S(~Time + Quadratic + Cubic + pbd_a) 5 1312.418 68.30495
3 S(~Time + Quadratic + Cubic + dog_m) 5 1312.437 68.32465
17 S(~Time + Quadratic + Cubic + season) 18 1316.335 72.22230
31 S(~hum_a) 2 1319.817 75.70456
22 S(~dog_a) 2 1322.208 78.09496
30 S(~hof_a) 2 1323.342 79.22966
33 S(~hum_m) 2 1323.688 79.57516
44 S(~veh_a) 2 1323.910 79.79716
26 S(~1) 1 1324.618 80.50538
46 S(~veh_m) 2 1325.016 80.90346
20 S(~dof_m) 2 1325.745 81.63216
18 S(~dof_a) 2 1325.862 81.74896
36 S(~pbd_a) 2 1326.116 82.00306
24 S(~dog_m) 2 1326.240 82.12736
38 S(~pbd_m) 2 1326.616 82.50376
29 S(~nest_hab) 3 1327.398 83.28558
41 S(~season) 15 1330.042 85.92979
37 S(~pbd_a + level) 6 1346.129 102.01590
35 S(~level) 5 1348.143 104.02985
39 S(~pbd_m + level) 6 1350.415 106.30250
weight Deviance
28 9.999864e-01 1232.093
10 3.329514e-06 1249.286
11 2.698890e-06 1251.716
32 2.067411e-06 1258.271
7 8.517875e-07 1256.031
8 7.963556e-07 1254.157
12 7.563814e-07 1254.260
23 4.931691e-07 1261.138
42 4.051899e-07 1259.524
34 3.627820e-07 1261.752
13 3.425254e-07 1255.844
14 3.175375e-07 1255.996
9 3.123098e-07 1256.029
45 3.091579e-07 1262.072
47 1.820083e-07 1263.131
19 1.710836e-07 1263.255
21 1.216992e-07 1263.936
25 1.001133e-07 1264.327
27 2.936114e-08 1274.797
5 1.340647e-14 1297.985
2 4.325325e-15 1300.247
1 3.938659e-15 1302.439
6 3.560273e-15 1300.636
40 2.040147e-15 1305.758
4 1.606508e-15 1300.222
43 1.558514e-15 1308.300
16 1.521562e-15 1302.337
15 1.471507e-15 1302.403
3 1.457084e-15 1302.423
17 0.000000e+00 1280.174
31 0.000000e+00 1315.814
22 0.000000e+00 1318.205
30 0.000000e+00 1319.340
33 0.000000e+00 1319.685
44 0.000000e+00 1319.907
26 0.000000e+00 1322.617
46 0.000000e+00 1321.013
20 0.000000e+00 1321.742
18 0.000000e+00 1321.859
36 0.000000e+00 1322.113
24 0.000000e+00 1322.237
38 0.000000e+00 1322.614
29 0.000000e+00 1321.393
41 0.000000e+00 1299.929
37 0.000000e+00 1334.109
35 0.000000e+00 1338.128
39 0.000000e+00 1338.395Code
S.fundays_level <- nest_survival_run_BSC[[28]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays+level)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.fundays_level$results$beta estimate se lcl ucl
S:(Intercept) 1.8184297 0.3638827 1.1052195 2.5316398
S:fundays -0.1698848 0.0314907 -0.2316066 -0.1081629
S:levelL1 0.2731214 0.4054478 -0.5215563 1.0677991
S:levelL2 1.1678166 0.3746986 0.4334073 1.9022259
S:levelL3 1.5421279 0.3593802 0.8377426 2.2465131
S:levelL4 1.8751085 0.8007526 0.3056334 3.4445836Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_BSC$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_BSC$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_BSC$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.fundays_level <-
covariate.predictions(model = S.fundays_level,
data = data.frame(fundays = fundays.values),
indices = level_indices)
# store values of Level in pred.top
L0.rows <- which(pred.fundays_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.fundays_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.fundays_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.fundays_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.fundays_level$estimates$par.index == level_indices[5])
pred.fundays_level$estimates$level <- NA
pred.fundays_level$estimates$level[L0.rows] <- "L0"
pred.fundays_level$estimates$level[L1.rows] <- "L1"
pred.fundays_level$estimates$level[L2.rows] <- "L2"
pred.fundays_level$estimates$level[L3.rows] <- "L3"
pred.fundays_level$estimates$level[L4.rows] <- "L4"
head(pred.fundays_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.8603776 0.043712499 0.7512393
2 2 2 4681 0.0000000 0.8900793 0.020590627 0.8427807
3 3 3 13001 0.0000000 0.9519489 0.006995463 0.9362256
4 4 4 30941 0.0000000 0.9664489 0.003364315 0.9591915
5 5 5 74101 0.0000000 0.9757204 0.017017367 0.9076803
6 6 1 1 0.2424242 0.8553564 0.044733494 0.7443289
ucl fixed level
1 0.9263294 L0
2 0.9244244 L1
3 0.9639450 L2
4 0.9724526 L3
5 0.9939489 L4
6 0.9231474 L0Code
# build and store the plot in object 'p'
fundays_level_nest_survival_plot <-
ggplot(pred.fundays_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20, 30)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0, 1)) +
ggtitle("Bellarine / Surf Coast")
fundays_level_nest_survival_plot
Code
#### effect of fundays
S.fundays <- nest_survival_run_BSC[[27]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~fundays)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.fundays$results$beta estimate se lcl ucl
S:(Intercept) 3.1934401 0.0880475 3.0208669 3.3660132
S:fundays -0.1923356 0.0282399 -0.2476858 -0.1369854Code
# create values of pbd_a to use for predictions
min.fundays = min(RMark_data_BSC$nest_data.processed$data$fundays)
max.fundays = max(RMark_data_BSC$nest_data.processed$data$fundays)
fundays.values = seq(from = min.fundays, to = max.fundays, length = 100)
pred.fundays <-
covariate.predictions(model = S.fundays,
data = data.frame(fundays = fundays.values),
indices = 1)
fundays_nest_survival_plot <-
ggplot(pred.fundays$estimates,
aes(x = covdata, y = estimate)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 5, 10)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("number of weekend days and holidays exposed to") +
ylab("estimated daily survival rate (± 95% CI)") +
ylim(c(0, 1)) +
ggtitle("Bellarine / Surf Coast")
fundays_nest_survival_plot
Code
#### effect of predatory birds and level
S.pbd_m_level <- nest_survival_run_BSC[[39]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~pbd_m + level)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.pbd_m_level$results$beta estimate se lcl ucl
S:(Intercept) 1.0579662000 0.1343437 0.7946526000 1.3212797000
S:pbd_m -0.0000237846 0.0000000 -0.0000237846 -0.0000237846
S:levelL1 0.7673503000 0.2413980 0.2942103000 1.2404903000
S:levelL2 1.6167889000 0.1913246 1.2417928000 1.9917851000
S:levelL3 2.0069296000 0.1577046 1.6978286000 2.3160307000
S:levelL4 21.9630520000 4.3697359 13.3983700000 30.5277350000Code
# create values of pbd_a to use for predictions
min.pbd_m = min(RMark_data_BSC$nest_data.processed$data$pbd_m)
max.pbd_m = max(RMark_data_BSC$nest_data.processed$data$pbd_m)
pbd_m.values = seq(from = min.pbd_m, to = max.pbd_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_BSC$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.pbd_m_level <-
covariate.predictions(model = S.pbd_m_level,
data = data.frame(pbd_m = pbd_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.pbd_m_level$estimates$par.index == level_indices[5])
pred.pbd_m_level$estimates$level <- NA
pred.pbd_m_level$estimates$level[L0.rows] <- "L0"
pred.pbd_m_level$estimates$level[L1.rows] <- "L1"
pred.pbd_m_level$estimates$level[L2.rows] <- "L2"
pred.pbd_m_level$estimates$level[L3.rows] <- "L3"
pred.pbd_m_level$estimates$level[L4.rows] <- "L4"
head(pred.pbd_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.000000 0.7423017 2.569859e-02 0.6888305
2 2 2 4681 0.000000 0.8612029 2.397354e-02 0.8072477
3 3 3 13001 0.000000 0.9355205 8.217194e-03 0.9174174
4 4 4 30941 0.000000 0.9554213 3.517920e-03 0.9479950
5 5 5 74101 0.000000 1.0000000 4.360579e-10 0.9999995
6 6 1 1 2.341137 0.7422911 2.569929e-02 0.6888185
ucl fixed level
1 0.7893938 L0
2 0.9018905 L1
3 0.9498719 L2
4 0.9618298 L3
5 1.0000000 L4
6 0.7893844 L0Code
# build and store the plot in object 'p'
pbd_m_level_nest_survival_plot <-
ggplot(pred.pbd_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 200, 400, 600)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of predatory birds counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Bellarine / Surf Coast")
pbd_m_level_nest_survival_plot
Code
#### effect of humans and level
S.hum_m_level <- nest_survival_run_BSC[[34]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~hum_m + level)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.hum_m_level$results$beta estimate se lcl ucl
S:(Intercept) 1.0693732 0.3159529 0.4501055 1.6886408
S:hum_m 0.0068711 0.0060491 -0.0049851 0.0187273
S:levelL1 0.7161244 0.3734279 -0.0157942 1.4480430
S:levelL2 1.5440258 0.3432975 0.8711628 2.2168889
S:levelL3 1.9738662 0.3263978 1.3341265 2.6136059
S:levelL4 2.4456902 0.7837947 0.9094526 3.9819279Code
# create values of pbd_m to use for predictions
min.hum_m = min(RMark_data_BSC$nest_data.processed$data$hum_m)
max.hum_m = max(RMark_data_BSC$nest_data.processed$data$hum_m)
hum_m.values = seq(from = min.hum_m, to = max.hum_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_BSC$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.hum_m_level <-
covariate.predictions(model = S.hum_m_level,
data = data.frame(hum_m = hum_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.hum_m_level$estimates$par.index == level_indices[5])
pred.hum_m_level$estimates$level <- NA
pred.hum_m_level$estimates$level[L0.rows] <- "L0"
pred.hum_m_level$estimates$level[L1.rows] <- "L1"
pred.hum_m_level$estimates$level[L2.rows] <- "L2"
pred.hum_m_level$estimates$level[L3.rows] <- "L3"
pred.hum_m_level$estimates$level[L4.rows] <- "L4"
head(pred.hum_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.000000 0.7444777 0.060103928 0.6106670
2 2 2 4681 0.000000 0.8563744 0.024615723 0.8011099
3 3 3 13001 0.000000 0.9317190 0.008649083 0.9126906
4 4 4 30941 0.000000 0.9544897 0.003681107 0.9467052
5 5 5 74101 0.000000 0.9711133 0.020129725 0.8917393
6 6 1 1 1.354515 0.7462441 0.059787203 0.6129827
ucl fixed level
1 0.8440438 L0
2 0.8982336 L1
3 0.9468418 L2
4 0.9611839 L3
5 0.9927645 L4
6 0.8452070 L0Code
# build and store the plot in object 'p'
hum_m_level_nest_survival_plot <-
ggplot(pred.hum_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 100, 200), limits = c(0, 100)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of humans counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Bellarine / Surf Coast")
hum_m_level_nest_survival_plot
Code
#### effect of dogs and level
S.dog_m_level <- nest_survival_run_BSC[[25]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dog_m + level)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.dog_m_level$results$beta estimate se lcl ucl
S:(Intercept) 1.0775988 0.3162079 0.4578313 1.6973664
S:dog_m 0.0104433 0.0310886 -0.0504902 0.0713769
S:levelL1 0.7209444 0.3733108 -0.0107447 1.4526336
S:levelL2 1.5614634 0.3432425 0.8887080 2.2342187
S:levelL3 1.9803018 0.3264236 1.3405115 2.6200921
S:levelL4 2.4559828 0.7839901 0.9193621 3.9926035Code
# create values of pbd_m to use for predictions
min.dog_m = min(RMark_data_BSC$nest_data.processed$data$dog_m)
max.dog_m = max(RMark_data_BSC$nest_data.processed$data$dog_m)
dog_m.values = seq(from = min.dog_m, to = max.dog_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_BSC$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dog_m_level <-
covariate.predictions(model = S.dog_m_level,
data = data.frame(dog_m = dog_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dog_m_level$estimates$par.index == level_indices[5])
pred.dog_m_level$estimates$level <- NA
pred.dog_m_level$estimates$level[L0.rows] <- "L0"
pred.dog_m_level$estimates$level[L1.rows] <- "L1"
pred.dog_m_level$estimates$level[L2.rows] <- "L2"
pred.dog_m_level$estimates$level[L3.rows] <- "L3"
pred.dog_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dog_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.7460393 0.059910223 0.6125023
2 2 2 4681 0.0000000 0.8579715 0.024395172 0.8031605
3 3 3 13001 0.0000000 0.9333336 0.008525707 0.9145504
4 4 4 30941 0.0000000 0.9551224 0.003739979 0.9471944
5 5 5 74101 0.0000000 0.9716283 0.019776184 0.8935490
6 6 1 1 0.1036789 0.7462445 0.059844996 0.6128410
ucl fixed level
1 0.8451890 L0
2 0.8994312 L1
3 0.9482217 L2
4 0.9619079 L3
5 0.9928937 L4
6 0.8452855 L0Code
# build and store the plot in object 'p'
dog_m_level_nest_survival_plot <-
ggplot(pred.dog_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20), limits = c(0, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max .number of dogs counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Bellarine / Surf Coast")
dog_m_level_nest_survival_plot
Code
#### effect of dofs and level
S.dof_m_level <- nest_survival_run_BSC[[21]]
# mark(data = RMark_data_BSC$nest_data.processed,
# ddl = RMark_data_BSC$nest_fate.ddl,
# model = "Nest",
# model.parameters = list(S = list(formula = ~dof_m + level)),
# nocc = occ_BSC,
# brief = TRUE,
# delete = TRUE)
S.dof_m_level$results$beta estimate se lcl ucl
S:(Intercept) 1.1037231 0.3170246 0.4823550 1.7250913
S:dof_m -0.0358645 0.0480731 -0.1300877 0.0583587
S:levelL1 0.7211471 0.3734436 -0.0108023 1.4530965
S:levelL2 1.5694998 0.3435422 0.8961570 2.2428426
S:levelL3 1.9814962 0.3265525 1.3414533 2.6215391
S:levelL4 2.4298582 0.7843201 0.8925908 3.9671257Code
# create values of pbd_m to use for predictions
min.dof_m = min(RMark_data_BSC$nest_data.processed$data$dof_m)
max.dof_m = max(RMark_data_BSC$nest_data.processed$data$dof_m)
dof_m.values = seq(from = min.dof_m, to = max.dof_m, length = 300)
# determine which parameter indices go with males and females
level_indices <-
RMark_data_BSC$nest_fate.ddl$S %>%
mutate(index = row.names(.)) %>%
group_by(level) %>%
slice(1) %>%
pull(index) %>%
as.numeric()
pred.dof_m_level <-
covariate.predictions(model = S.dof_m_level,
data = data.frame(dof_m = dof_m.values),
indices = level_indices)
# store values of sex in pred.top
L0.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[1])
L1.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[2])
L2.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[3])
L3.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[4])
L4.rows <- which(pred.dof_m_level$estimates$par.index == level_indices[5])
pred.dof_m_level$estimates$level <- NA
pred.dof_m_level$estimates$level[L0.rows] <- "L0"
pred.dof_m_level$estimates$level[L1.rows] <- "L1"
pred.dof_m_level$estimates$level[L2.rows] <- "L2"
pred.dof_m_level$estimates$level[L3.rows] <- "L3"
pred.dof_m_level$estimates$level[L4.rows] <- "L4"
head(pred.dof_m_level$estimates) vcv.index model.index par.index covdata estimate se lcl
1 1 1 1 0.0000000 0.7509571 0.059290112 0.6183065
2 2 2 4681 0.0000000 0.8611495 0.024034524 0.8070423
3 3 3 13001 0.0000000 0.9354280 0.008419793 0.9168284
4 4 4 30941 0.0000000 0.9562789 0.003611708 0.9486273
5 5 5 74101 0.0000000 0.9716283 0.019776202 0.8935490
6 6 1 1 0.1003344 0.7502835 0.059327931 0.6176279
ucl fixed level
1 0.8487820 L0
2 0.9019282 L1
3 0.9500946 L2
4 0.9628356 L3
5 0.9928937 L4
6 0.8482263 L0Code
# build and store the plot in object 'p'
dof_m_level_nest_survival_plot <-
ggplot(pred.dof_m_level$estimates,
aes(x = covdata, y = estimate, color = level)) +
geom_line(size = 1.5) +
geom_ribbon(aes(ymin = lcl, ymax = ucl), alpha = 0.2) +
facet_grid(. ~ level) +
scale_colour_brewer(palette = "Set1") +
scale_x_continuous(breaks = c(0, 10, 20), limits = c(0, 20)) +
luke_theme +
theme(legend.position = "none",
legend.justification = c(1, 0)) +
xlab("max. number of dogs off leash counted") +
ylab("estimated daily survival rate (± 95% CI)") +
ggtitle("Bellarine / Surf Coast")
dof_m_level_nest_survival_plot
Variation among years
Code
### FP ----
nest_survival_reals_FP_season <-
nest_survival_run_FP[[43]]$results$real
Groups <- data.frame(
str_split_fixed(rownames(nest_survival_reals_FP_season), " ", n = 4))
nest_survival_reals_FP_season <- cbind(Groups, nest_survival_reals_FP_season)
nest_survival_reals_FP_season$season <-
as.numeric(str_sub(nest_survival_reals_FP_season$X2, 2, 5))
nest_survival_reals_FP_season$management_status <-
as.factor(str_sub(nest_survival_reals_FP_season$X2,
nchar(nest_survival_reals_FP_season$X2), nchar(nest_survival_reals_FP_season$X2)))
nest_survival_reals_FP_season$nest_hab <-
gsub(x = nest_survival_reals_FP_season$X2, pattern = "[^a-zA-Z]", replacement = "") %>%
str_sub(., start = 2, end = nchar(.)-1) %>% as.factor()
nest_survival_reals_FP_season <-
nest_survival_reals_FP_season %>%
dplyr::select(season, management_status, nest_hab, estimate, se, lcl, ucl) %>%
arrange(season)
row.names(nest_survival_reals_FP_season) <- NULL
# summarise habitats for each year in FP
nest_data_FP %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season) %>%
summarise(n_habitats = n_distinct(nest_hab))# A tibble: 12 × 2
season n_habitats
<chr> <int>
1 2009 3
2 2010 3
3 2011 3
4 2012 3
5 2013 3
6 2014 3
7 2015 3
8 2016 3
9 2017 3
10 2018 3
11 2019 3
12 2020 3Code
nest_data_FP %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season, nest_hab) %>%
summarise(n_nests = n_distinct(nest_ID)) %>%
pivot_wider(names_from = nest_hab, values_from = n_nests)# A tibble: 12 × 4
# Groups: season [12]
season Beach Dune `Foredune/face`
<chr> <int> <int> <int>
1 2009 8 1 2
2 2010 17 6 5
3 2011 8 2 5
4 2012 16 5 6
5 2013 16 4 10
6 2014 23 6 8
7 2015 25 1 6
8 2016 29 8 12
9 2017 36 4 13
10 2018 49 5 22
11 2019 50 8 15
12 2020 53 10 26Code
nest_data_FP %>%
filter(season %in% ("2009"))# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# plot the annual variation in daily nest survival
ggplot() +
geom_errorbar(data = nest_survival_reals_FP_season,
aes(x = season, ymax = ucl, ymin = lcl),
alpha = 1, color = "black", width = 0.05, lwd = 0.5) +
geom_point(data = nest_survival_reals_FP_season,
aes(x = season, y = estimate),
# lwd = 1,
shape = 21, color= "black") +
scale_x_continuous(breaks = c(2006:2020)) +
ylab("daily nest survival ± 95% CI") +
scale_y_continuous(limits = c(0.4, 1)) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
scale_color_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
luke_theme +
theme(legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 1)) +
ggtitle("Fleurieu Peninsula")
Code
### MP ----
nest_survival_reals_MP_season <-
nest_survival_run_MP[[43]]$results$real
Groups <- data.frame(
str_split_fixed(rownames(nest_survival_reals_MP_season), " ", n = 4))
nest_survival_reals_MP_season <- cbind(Groups, nest_survival_reals_MP_season)
nest_survival_reals_MP_season$season <-
as.numeric(str_sub(nest_survival_reals_MP_season$X2, 2, 5))
nest_survival_reals_MP_season$management_status <-
as.factor(str_sub(nest_survival_reals_MP_season$X2,
nchar(nest_survival_reals_MP_season$X2), nchar(nest_survival_reals_MP_season$X2)))
nest_survival_reals_MP_season$nest_hab <-
gsub(x = nest_survival_reals_MP_season$X2, pattern = "[^a-zA-Z]", replacement = "") %>%
str_sub(., start = 2, end = nchar(.)-1) %>% as.factor()
nest_survival_reals_MP_season <-
nest_survival_reals_MP_season %>%
dplyr::select(season, management_status, nest_hab, estimate, se, lcl, ucl) %>%
arrange(season)
row.names(nest_survival_reals_MP_season) <- NULL
# summarise habitats for each year in MP
nest_data_MP %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season) %>%
summarise(n_habitats = n_distinct(nest_hab))# A tibble: 15 × 2
season n_habitats
<chr> <int>
1 2006 3
2 2007 4
3 2008 3
4 2009 3
5 2010 4
6 2011 4
7 2012 4
8 2013 3
9 2014 3
10 2015 4
11 2016 4
12 2017 3
13 2018 4
14 2019 3
15 2020 3Code
nest_data_MP %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season, nest_hab) %>%
summarise(n_nests = n_distinct(nest_ID)) %>%
pivot_wider(names_from = nest_hab, values_from = n_nests)# A tibble: 15 × 5
# Groups: season [15]
season Beach Dune `Foredune/face` Rocks
<chr> <int> <int> <int> <int>
1 2006 9 14 1 NA
2 2007 10 15 7 1
3 2008 2 10 1 NA
4 2009 10 12 11 NA
5 2010 11 35 3 1
6 2011 11 25 7 2
7 2012 21 16 12 2
8 2013 15 16 14 NA
9 2014 28 22 14 NA
10 2015 41 21 15 1
11 2016 47 24 20 1
12 2017 25 14 26 NA
13 2018 30 19 15 1
14 2019 21 21 18 NA
15 2020 32 19 25 NACode
nest_data_MP %>%
filter(season %in% ("2009"))# A tibble: 0 × 26
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# plot the annual variation in daily nest survival
ggplot() +
geom_errorbar(data = nest_survival_reals_MP_season,
aes(x = season, ymax = ucl, ymin = lcl),
alpha = 1, color = "black", width = 0.05, lwd = 0.5) +
geom_point(data = nest_survival_reals_MP_season,
aes(x = season, y = estimate),
# lwd = 1,
shape = 21, color= "black") +
scale_x_continuous(breaks = c(2006:2020)) +
ylab("daily nest survival ± 95% CI") +
scale_y_continuous(limits = c(0.4, 1)) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
scale_color_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
luke_theme +
theme(legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 1)) +
ggtitle("Mornington Peninsula")
Code
### BSC ----
nest_survival_reals_BSC_season <-
nest_survival_run_BSC[[43]]$results$real
Groups <- data.frame(
str_split_fixed(rownames(nest_survival_reals_BSC_season), " ", n = 4))
nest_survival_reals_BSC_season <- cbind(Groups, nest_survival_reals_BSC_season)
nest_survival_reals_BSC_season$season <-
as.numeric(str_sub(nest_survival_reals_BSC_season$X2, 2, 5))
nest_survival_reals_BSC_season$management_status <-
as.factor(str_sub(nest_survival_reals_BSC_season$X2,
nchar(nest_survival_reals_BSC_season$X2), nchar(nest_survival_reals_BSC_season$X2)))
nest_survival_reals_BSC_season$nest_hab <-
gsub(x = nest_survival_reals_BSC_season$X2, pattern = "[^a-zA-Z]", replacement = "") %>%
str_sub(., start = 2, end = nchar(.)-1) %>% as.factor()
nest_survival_reals_BSC_season <-
nest_survival_reals_BSC_season %>%
dplyr::select(season, management_status, nest_hab, estimate, se, lcl, ucl) %>%
arrange(season)
row.names(nest_survival_reals_BSC_season) <- NULL
# summarise habitats for each year in BSC
nest_data_BSC %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season) %>%
summarise(n_habitats = n_distinct(nest_hab))# A tibble: 15 × 2
season n_habitats
<chr> <int>
1 2006 2
2 2007 2
3 2008 2
4 2009 2
5 2010 3
6 2011 3
7 2012 3
8 2013 2
9 2014 3
10 2015 3
11 2016 3
12 2017 3
13 2018 3
14 2019 3
15 2020 3Code
nest_data_BSC %>%
mutate(season = str_sub(season, 1, 4)) %>%
group_by(season, nest_hab) %>%
summarise(n_nests = n_distinct(nest_ID)) %>%
pivot_wider(names_from = nest_hab, values_from = n_nests)# A tibble: 15 × 4
# Groups: season [15]
season Beach Dune `Foredune/face`
<chr> <int> <int> <int>
1 2006 3 10 NA
2 2007 4 10 NA
3 2008 7 7 NA
4 2009 9 9 NA
5 2010 13 10 1
6 2011 12 13 4
7 2012 10 8 9
8 2013 7 NA 13
9 2014 13 9 11
10 2015 14 11 9
11 2016 26 13 12
12 2017 25 8 14
13 2018 19 13 15
14 2019 15 17 16
15 2020 27 13 16Code
nest_data_BSC %>%
filter(season %in% ("2009"))# A tibble: 0 × 26
# Groups: season [0]
# ℹ 26 variables: season <fct>, site <fct>, nest_ID <chr>, first_found <chr>,
# last_alive <chr>, last_checked <chr>, Fate <dbl>, nest_hab <fct>,
# management_status <fct>, management_type <chr>, nest_lat <chr>,
# nest_lon <chr>, first_found2 <date>, last_alive2 <date>,
# last_checked2 <date>, FirstFound <dbl>, LastPresent <dbl>,
# LastChecked <dbl>, sign_access <dbl>, sign_nest <dbl>, rope_fence <dbl>,
# wardens <dbl>, none <dbl>, management_level <dbl>, nocc <dbl>, …Code
# plot the annual variation in daily nest survival
ggplot() +
geom_errorbar(data = nest_survival_reals_BSC_season,
aes(x = season, ymax = ucl, ymin = lcl),
alpha = 1, color = "black", width = 0.05, lwd = 0.5) +
geom_point(data = nest_survival_reals_BSC_season,
aes(x = season, y = estimate),
# lwd = 1,
shape = 21, color= "black") +
scale_x_continuous(breaks = c(2006:2020)) +
ylab("daily nest survival ± 95% CI") +
scale_y_continuous(limits = c(0.4, 1)) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
scale_color_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
luke_theme +
theme(legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 1)) +
ggtitle("Bellarine / Surf Coast")
Variation within years
Code
# Extract estimates of survival from Cubic model with management
# (non-linear season variation and management effect)
nest_survival_reals_MP <-
nest_survival_run_MP[[1]]$results$real
nest_survival_reals_BSC <-
nest_survival_run_MP[[1]]$results$real
nest_survival_reals_FP <-
nest_survival_run_MP[[1]]$results$real
# wrangle dataframe to tidy up model predictions in prep for plotting
RMark_pred_tidy <-
function(nest_survival_reals){
Groups <- data.frame(
str_split_fixed(rownames(nest_survival_reals), " ", n = 4))
nest_survival_reals <- cbind(Groups, nest_survival_reals)
nest_survival_reals$day_of_season <-
as.numeric(unlist(substr(nest_survival_reals$X4, 2, 4)))
nest_survival_reals$management_status <-
as.factor(str_sub(nest_survival_reals$X2,
nchar(nest_survival_reals$X2), nchar(nest_survival_reals$X2)))
nest_survival_reals$nest_hab <-
gsub(x = nest_survival_reals$X2, pattern = "[^a-zA-Z]", replacement = "") %>%
str_sub(., start = 2, end = nchar(.)-1) %>% as.factor()
nest_survival_reals <-
nest_survival_reals[1:nrow(nest_survival_reals) - 1,]
nest_survival_reals
}
nest_survival_reals_tidy_MP <- RMark_pred_tidy(nest_survival_reals_MP)
nest_survival_reals_tidy_BSC <- RMark_pred_tidy(nest_survival_reals_BSC)
nest_survival_reals_tidy_FP <- RMark_pred_tidy(nest_survival_reals_FP)
#### plotting ----
# make a dataframe of dates from start to end of season for plot
nest_survival_plotR <-
function(nest_data,
nest_survival_reals_tidy,
plot_title = "2006-2021 breeding seasons at Mornington Peninsula"){
dates_for_plot <-
data.frame(date = as.Date(min(as.numeric(nest_data$FirstFound)):
max(max(as.numeric(nest_data$LastChecked)),
max(as.numeric(nest_data$LastPresent))),
origin = "2023-01-01") - 180,
day_of_season = c(0:(max(max(as.numeric(nest_data$LastChecked)),
max(as.numeric(nest_data$LastPresent))) -
min(as.numeric(nest_data$FirstFound)))))
nest_survival_reals_tidy_dates <-
left_join(nest_survival_reals_tidy, dates_for_plot, by = "day_of_season")
# plot the seasonal variation in daily nest survival
nest_survival_season_plot <-
ggplot(data = nest_survival_reals_tidy_dates, aes(group = management_status)) +
geom_ribbon(aes(x = date, ymin = lcl, ymax = ucl, fill = management_status),
# fill = brewer.pal(8, "Set1")[c(2, 1)],
alpha = 0.3) +
geom_line(aes(x = date, y = estimate, color = management_status),
# color = brewer.pal(8, "Set1")[c(2, 1)],
size = 1) +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months") +
ylab("daily nest survival ± 95% CI") +
scale_y_continuous(limits = c(0.4, 1)) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
scale_color_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
luke_theme +
theme(legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 1))
# plot the seasonal variation in daily nest discovery
nest_discovery_season_plot <-
ggplot(nest_data, aes(as.Date(FirstFound, origin = "2023-01-01") - 180,
fill = management_status)) +
geom_histogram(bins = 30,
# fill = brewer.pal(8, "Set1")[c(2)],
alpha = 0.5) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(2, 1)],
labels = c("Unmanaged", "Managed")) +
ylab("nests found\nweekly") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_survival_reals_tidy_dates$date, na.rm = TRUE),
max(nest_survival_reals_tidy_dates$date, na.rm = TRUE))) +
scale_y_continuous(breaks = c(10, 20, 30, 40)) +
luke_theme +
theme(legend.position = "none",
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank())
# merge plots together
hooded_plover_nest_plot <-
nest_discovery_season_plot +
nest_survival_season_plot +
plot_layout(widths = c(5),
heights = unit(c(0.75, 3), c('in', 'in'))) +
plot_annotation(tag_levels = 'A', title = "Hooded Plover Nest Survival",
subtitle = plot_title)
hooded_plover_nest_plot
}
nest_survival_plotR(nest_data = nest_data_MP,
nest_survival_reals_tidy = nest_survival_reals_tidy_MP,
plot_title = "2006-2021 breeding seasons at Mornington Peninsula")
Code
nest_survival_plotR(nest_data = nest_data_BSC,
nest_survival_reals_tidy = nest_survival_reals_tidy_BSC,
plot_title = "2006-2021 breeding seasons at Bellarine / Surf Coast")
Code
nest_survival_plotR(nest_data = nest_data_FP,
nest_survival_reals_tidy = nest_survival_reals_tidy_FP,
plot_title = "2009-2021 breeding seasons at Fleurieu Peninsula")
Code
# Extract estimates of survival from Cubic model with management
# (non-linear season variation and management effect)
nest_survival_reals_MP <-
nest_survival_run_MP[[9]]$results$real
nest_survival_reals_BSC <-
nest_survival_run_MP[[9]]$results$real
nest_survival_reals_FP <-
nest_survival_run_MP[[9]]$results$real
# wrangle dataframe to tidy up model predictions in prep for plotting
RMark_pred_tidy <-
function(nest_survival_reals){
Groups <- data.frame(
str_split_fixed(rownames(nest_survival_reals), " ", n = 4))
nest_survival_reals <- cbind(Groups, nest_survival_reals)
nest_survival_reals$day_of_season <-
as.numeric(unlist(substr(nest_survival_reals$X4, 2, 4)))
nest_survival_reals$management_level <-
as.factor(str_sub(nest_survival_reals$X2,
nchar(nest_survival_reals$X2), nchar(nest_survival_reals$X2)))
nest_survival_reals$nest_hab <-
gsub(x = nest_survival_reals$X2, pattern = "[^a-zA-Z]", replacement = "") %>%
str_sub(., start = 2, end = nchar(.)-1) %>% as.factor()
nest_survival_reals <-
nest_survival_reals[1:nrow(nest_survival_reals) - 1,]
nest_survival_reals
}
nest_survival_reals_tidy_MP <- RMark_pred_tidy(nest_survival_reals_MP)
nest_survival_reals_tidy_BSC <- RMark_pred_tidy(nest_survival_reals_BSC)
nest_survival_reals_tidy_FP <- RMark_pred_tidy(nest_survival_reals_FP)
#### plotting ----
# make a dataframe of dates from start to end of season for plot
nest_survival_plotR <-
function(nest_data,
nest_survival_reals_tidy,
plot_title = "2006-2021 breeding seasons at Mornington Peninsula"){
dates_for_plot <-
data.frame(date = as.Date(min(as.numeric(nest_data$FirstFound)):
max(max(as.numeric(nest_data$LastChecked)),
max(as.numeric(nest_data$LastPresent))),
origin = "2023-01-01") - 180,
day_of_season = c(0:(max(max(as.numeric(nest_data$LastChecked)),
max(as.numeric(nest_data$LastPresent))) -
min(as.numeric(nest_data$FirstFound)))))
nest_survival_reals_tidy_dates <-
left_join(nest_survival_reals_tidy, dates_for_plot, by = "day_of_season")
# plot the seasonal variation in daily nest survival
nest_survival_season_plot <-
ggplot(data = nest_survival_reals_tidy_dates, aes(group = management_level)) +
geom_ribbon(aes(x = date, ymin = lcl, ymax = ucl, fill = management_level),
# fill = brewer.pal(8, "Set1")[c(2, 1)],
alpha = 0.3) +
geom_line(aes(x = date, y = estimate, color = management_level),
# color = brewer.pal(8, "Set1")[c(2, 1)],
size = 1) +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months") +
ylab("daily nest survival ± 95% CI") +
scale_y_continuous(limits = c(0.4, 1)) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(1:5)],
labels = c("Level 0", "Level 1", "Level 2", "Level 3", "Level 4")) +
scale_color_manual(values = brewer.pal(8, "Set1")[c(1:5)],
labels = c("Level 0", "Level 1", "Level 2", "Level 3", "Level 4")) +
luke_theme +
theme(legend.position = "bottom",
legend.title = element_blank(),
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45,
hjust = 1,
vjust = 1))
# plot the seasonal variation in daily nest discovery
nest_discovery_season_plot <-
ggplot(nest_data, aes(as.Date(FirstFound, origin = "2023-01-01") - 180,
fill = management_level)) +
geom_histogram(bins = 30,
# fill = brewer.pal(8, "Set1")[c(2)],
alpha = 0.5) +
scale_fill_manual(values = brewer.pal(8, "Set1")[c(1:5)],
labels = c("Level 0", "Level 1", "Level 2", "Level 3", "Level 4")) +
ylab("nests found\nweekly") +
scale_x_date(date_labels = "%B",
expand = c(0.01, 0.01),
date_breaks = "1 months", limits = c(min(nest_survival_reals_tidy_dates$date, na.rm = TRUE),
max(nest_survival_reals_tidy_dates$date, na.rm = TRUE))) +
scale_y_continuous(breaks = c(10, 20, 30, 40)) +
luke_theme +
theme(legend.position = "none",
panel.grid.major = element_line(colour = "grey70",
size = 0.15),
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank())
# merge plots together
hooded_plover_nest_plot <-
nest_discovery_season_plot +
nest_survival_season_plot +
plot_layout(widths = c(5),
heights = unit(c(0.75, 3), c('in', 'in'))) +
plot_annotation(tag_levels = 'A', title = "Hooded Plover Nest Survival",
subtitle = plot_title)
hooded_plover_nest_plot
}
nest_survival_plotR(nest_data = nest_data_MP,
nest_survival_reals_tidy = nest_survival_reals_tidy_MP,
plot_title = "2006-2021 breeding seasons at Mornington Peninsula")
Code
nest_survival_plotR(nest_data = nest_data_BSC,
nest_survival_reals_tidy = nest_survival_reals_tidy_BSC,
plot_title = "2006-2021 breeding seasons at Bellarine / Surf Coast")
Code
nest_survival_plotR(nest_data = nest_data_FP,
nest_survival_reals_tidy = nest_survival_reals_tidy_FP,
plot_title = "2009-2021 breeding seasons at Fleurieu Peninsula")